perm filename PIX.SAI[S,HE]7 blob
sn#676060 filedate 1982-09-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00078 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00009 00002 BEGIN "PIX"
C00018 00003 ["?"]
C00022 00004 ["←"] comment alter camera number
C00030 00005 ["I"] comment input a file
C00034 00006 ["⊂"] comment input a raw byte buffer file
C00037 00007 ["β"] comment input a font character
C00041 00008 ["+"] comment add an input a file
C00042 00009 ["*"] comment multiply by an input a file
C00043 00010 ["%"] comment give information about a file
C00048 00011 ["/"] comment input a portion of a file
C00052 00012 ["O"] comment output a file
C00053 00013 ["¬"] comment output a 1 bit picture to the XGP
C00054 00014 ["D"]["∂"]["∧"] comment video synthesizer display
C00059 00015 ["!"] comment redraw old video synthesizer display
C00064 00016 ["∃"] comment quick and dirty video synthesizer display
C00068 00017 ["H"]["R"]["A"] comment some kind of halftone
C00071 00018 ["∀"] comment simple halftone display
C00073 00019 ["X"] comment send previous halftone to the XGP
C00078 00020 [">"] comment make a DD buffer into an MIT transferrable file
C00079 00021 ["<"] comment display MIT transferrable file
C00081 00022 ["#"] comment switch a video switch output
C00082 00023 ["P"] comment list a picture on the tty
C00085 00024 ["α"] comment add a letter to a font
C00087 00025 ["λ"] comment make an XGPable or editable file
C00099 00026 ["{"] comment read in a λ'd (XGPable) file
C00105 00027 ["C"] comment step past a certain number of pictures
C00106 00028 ["K"] comment clear the video synthesizer
C00107 00029 ["≡"] comment gronk synthesizer intensity table
C00109 00030 ["S"] comment change size of displays
C00116 00031 ["F"] comment high pass filter
C00117 00032 ["&"] comment measure noise
C00118 00033 [""] comment shrink the picture
C00121 00034 ["L"] comment low pass filter
C00122 00035 ["W"] comment select out a window
C00125 00036 ["\"] comment wipe out a window
C00128 00037 ["Z"] comment change size of a picture
C00130 00038 ["0"] comment special hack for PPH
C00132 00039 ["~"] comment dequantize a picture
C00135 00040 ["ε"] comment make DD buffer into a picture
C00140 00041 ["$"] comment general geometric transformation
C00145 00042 ["U"] comment remove blank border from a picture
C00147 00043 ["N"] comment apply noise remover
C00148 00044 ["V"] comment apply interest operator
C00149 00045 ["M"] comment pixel modification
C00153 00046 ["G"] comment histogram pixel values
C00156 00047 ["J"] comment histogram integrated pixel values
C00159 00048 ["E"] comment apply histogram normalizer
C00162 00049 ["Y"] comment apply vert sync loss correction
C00163 00050 ["∩"] comment for hackery
C00165 00051 ["∞"] comment extend mode
C00166 00052 ["?"] comment extend mode help
C00168 00053 ["E"] comment enhance edges
C00169 00054 ["O"] comment output a data compressed file
C00170 00055 [">"] comment output a CMU picture file
C00172 00056 ["⊂"] comment input packed byte file (scanline not on word boundary)
C00175 00057 ["S"] comment rearrange order of synthesizer channels
C00190 00058 ["M"] comment swap bytes in 12 bit pictures
C00191 00059 ["H"] comment make a giant halftone
C00196 00060 ["→"] comment make histogram of horizontal spatial variance
C00198 00061 ["↑"] comment make histogram of vertical spatial variance
C00200 00062 [""] comment set channel defaults through Grinnell ports
C00201 00063 ["!"] comment initialize the Grinnell for Ted's color kludge
C00202 00064 ["←"] comment set channel outputs as required
C00205 00065 ["D"] comment start a Grinnell demonstration file
C00209 00066 ["F"] comment finish a Grinnell demonstration file
C00210 00067 ["G"] comment draw picture on Grinnell display
C00211 00068 ["R"] comment read back picture from Grinnell display
C00213 00069 ["U"] comment read back unpacked picture from Grinnell display
C00215 00070 ["I"] comment take a GE format picture through the Grinnell digitizer
C00216 00071 ["V"] comment take a Vidicon picture through the Grinnell digitizer
C00217 00072 ["N"] comment set NFRAMES for multiple picture taking
C00218 00073 ["Z"] comment do zoom and pan
C00220 00074 ["P"] comment display text form of picture into file
C00223 00075 ELSE PRINT("huh?",'15&'12)
C00224 00076 ["Q"] comment exit
C00225 00077 This is the resting place for all defunct stuff. It should be put
C00243 00078 ELSE PRINT("?",'15&'12)
C00247 ENDMK
C⊗;
BEGIN "PIX"
comment require "5000S" compiler_switches; comment more string space;
COMMENT The above require doesn't work, so this one might...;
REQUIRE '15&'12&"Compile me with a 5000S compiler switch!" MESSAGE;
REQUIRE "VIXHDR.SAI[HDR,HE]" SOURCE_FILE;
require "outdpy[s,he]" load_module;
REQUIRE "CRDHDR.SAI[HDR,HE]" SOURCE_FILE;
REQUIRE "GEGRN[1,HHB]" LOAD_MODULE;
REQUIRE "CURS[1,HHB]" LOAD_MODULE;
EXTERNAL PROCEDURE GRPICTAKE(INTEGER CAMERA,NFRAMES);
EXTERNAL PROCEDURE GETAKE(REFERENCE INTEGER ARRAY DESTPIC;
INTEGER CAMERA,GCHAN; BOOLEAN CORRECTED;
INTEGER NFRAMES);
EXTERNAL PROCEDURE ZOOMCURSOR(INTEGER GCH,GRNLEFT,GRNTOP,PICLGT,PICWID;
REFERENCE INTEGER XCOORD,YCOORD; BOOLEAN MIDCURSOR,CURBLINK);
external procedure outdpy(string s; INTEGER SPOS(2), PPOS(-1));
DEFINE CRLF='15&'12;
INTEGER CAMERA,CHR,HIG,WID,BIT,PWANT,PHAVE,PDEFAULT;
STRING BACKLOG; REAL SSIZE,HSIZE,SASPECT,HASPECT;
INTEGER SDISWID,SDISHIG,SYPOS; REAL MAPTF; INTEGER MAPBT; REAL REDUN;
INTEGER HDISWID,HDISHIG,HAPOS;
BOOLEAN INITED,SYNLAS,HAFTONE;
INTEGER BCL,TCL,SUMS,XEE,YEE,NRTRY,NFRAMES,GRNLEFT,GRNTOP;
boolean outddcalled;
REAL TASPECT,TLEN,TWID;
INTEGER GRNCHAN;
BOOLEAN TBRITE,GRNDISP;
INTEGER LXB,LYB,UXB,UYB;
STRING INPOOT;
BOOLEAN GRNDEMO; COMMENT True during creation of Grinnell demo file.;
INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
INTEGER PROCEDURE PNEXTCH;
RETURN(IF LENGTH(BACKLOG)>0 THEN BACKLOG ELSE IF LENGTH(INPOOT)=0 THEN 0 ELSE INPOOT);
INTEGER PROCEDURE NEXTCH;
BEGIN
INTEGER NXC,M,FOO; OWN INTEGER EOF; OWN STRING FN;
PRELOAD_WITH -1; OWN INTEGER ARRAY DEVICE[1:1];
WHILE TRUE DO
IF DEVICE[1]=-1 THEN
BEGIN
IF LENGTH(BACKLOG)>0 THEN RETURN(LOP(BACKLOG));
IF LENGTH(INPOOT)=0 THEN INPOOT←INCHWL&"↔";
NXC←LOP(INPOOT);
IF NXC="'" THEN NXC←CVO(CVS(INTSCAN(INPOOT,FOO)));
IF NXC="@" THEN
BEGIN
STRING IFL;
DEVICE[1]←GETCHAN;
IFL←"";
WHILE (NXC←LOP(INPOOT))≠"↔" DO IFL←IFL&NXC;
PRSFIL("");
IF LENGTH(FN)>0 THEN PRSFIL(FN);
IF LENGTH(IFL)>0 THEN PRSFIL(IFL);
EOF←TRUE;
OPEN(DEVICE[1],DEVPRS,0,3,0,10,FOO,EOF);
LOOKUP(DEVICE[1],FILPRS,EOF);
BREAKSET(1,"","A");
BREAKSET(1,'12,"X");
BREAKSET(1,'12,"O");
OUTSTR(" reading "&DEVPRS&":"&FILPRS&'15&'12);
FN←DEVPRS&":"&FILPRS;
END
ELSE RETURN(NXC);
END
ELSE
IF EOF THEN
BEGIN
OUTSTR(" finished "&FN&'15&'12);
RELEASE(DEVICE[1]);
DEVICE[1]←-1;
END
ELSE
BEGIN
NXC←INPUT(DEVICE[1],1);
IF NXC='15 THEN NXC←"↔";
RETURN(NXC);
END;
END;
INTEGER PROCEDURE UINCHRW;
BEGIN
INTEGER CH;
DO CH←NEXTCH UNTIL CH≠"↔";
IF EQU(INPOOT,"↔") THEN NEXTCH;
RETURN(CH);
END;
STRING PROCEDURE UINCHWL;
BEGIN
STRING UINCH; INTEGER NC;
UINCH←"";
WHILE (NC←NEXTCH)≠"↔" DO UINCH←UINCH&NC;
RETURN(UINCH);
END;
Comment UOUTSTR should be used to type out prompts. It will not type them
if the argument has already been entered.;
PROCEDURE UOUTSTR(STRING STRN);
IF PNEXTCH=0 THEN OUTSTR(STRN);
PROCEDURE DRAWHIST(INTEGER ARRAY HIST; INTEGER FOO; INTEGER CHN);
Comment Draw a histogram with the values HIST[0] to HIST[FOO] on DD channel CHN
(automatically scales height);
BEGIN
INTEGER I,J,MAV;
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
SCREEN(-.3,-.2,1.1,1.2);
DRKEN; RECTAN(-100,-100,100,100);
LITEN;
LINE(0,0,0,1); LINE(0,1,1,1);
LINE(1,1,1,0); LINE(1,0,0,0);
LINE(0,.5,1,.5); LINE(0,.25,1,.25); LINE(0,.75,1,.75);
LINE(.5,0,.5,1); LINE(.25,0,.25,1); LINE(.75,0,.75,1);
MAV←0; FOR I←0 STEP 1 UNTIL FOO DO MAV←MAV MAX HIST[I];
MAV←MAV+1;
FOR I←1 STEP 1 UNTIL FOO DO
LINE((I-1)/FOO,HIST[I-1]/MAV,I/FOO,HIST[I]/MAV);
TXTPOS(0,-1/10,1/24,1/12); TEXT("0");
TXTPOS(1-LENGTH(CVS(FOO))/24,-1/10,1/24,1/12);
TEXT(CVS(FOO));
TXTPOS(-.07,0,1/24,1/12); TEXT("0");
TXTPOS(-.07-(LENGTH(CVS(MAV))-1)/24,1-1/12,1/24,1/12); TEXT(CVS(MAV));
ERASE(CHN);
DPYUP(CHN);
HAFTONE←FALSE; LXB←LYB←0; UXB←511; UYB←480;
SHOWA(CHN);
END;
REDUN←2;
LXB←LYB←0; UXB←511; UYB←480;
BCL←7; TCL←0;
YEE←0; XEE←1;
CAMERA←'41; BACKLOG←""; INITED←FALSE; SYNLAS←TRUE; HAFTONE←FALSE;
GRNDEMO ← FALSE;
HIG←260; WID←288; BIT←8; SUMS←1;
PDEFAULT←PWANT←PHAVE←PIXDIM(HIG,WID,BIT);
GRNDISP←FALSE;
TASPECT←3/10; TLEN←21; TWID←80; TBRITE←TRUE; NRTRY←15;
SSIZE←HSIZE←.5; SASPECT←HASPECT←481/512; MAPTF←1; MAPBT←4;
SDISWID←HDISWID←SDISHIG←HDISHIG←1; HAPOS←SYPOS←1;
GRNCHAN ← 0;
INPOOT←"";
DDINIT; SCREEN(-1,-1,1,1);
synmap(0,-1);
outddcalled←false;
OUTSTR("TYPE ?<CR> FOR COMMAND LIST"&'15&'12);
WHILE TRUE DO
BEGIN "LOOP"
INTEGER ARRAY PIC[0:PHAVE];
IF PHAVE=PDEFAULT THEN
BEGIN
MAKPIX(HIG,WID,BIT,PIC[0]);
INITED←TRUE;
END;
WHILE PHAVE=PWANT DO
BEGIN "SAMEARRAY"
MAPBT←MAPBT MAX PIC[BYBI];
IF LENGTH(BACKLOG)=0 THEN OUTSTR("*");
DO CHR←UCONV(UINCHRW) UNTIL CHR≠'15;
CASE CHR OF
BEGIN "COMMAND"
["?"]
BEGIN
outddcalled←true;
OUTdpy(" Pix Commands
← set digitizer input channel
I, O, β, ⊂ i/o pictures from/to a file, β from font, ⊂ raw
¬ send picture to XGP. Should be 1 bit/byte.
+, * add, multiply a picture from file with the current one
%, / for very large files. % gets dimensions, / reads in a part
D, ∂, ∃, ∧ display on video synthesizer, ∂ with grid, ∃ fast, ∧ no gray code
H, R, A, ∀ display a halftone (H good, R random, A arty, ∀ simple)
P, λ, { text dpy. P on TTY, λ XGP halftones or numbers, { read λ'd file
X, ε, α, >, < copy the last DD display
X to XGP, ε to picture, α to font, > to and < from MIT DDfiles
S set device, multiplicity, shape and size of displays.
C skip past a number of slots (when displaying multiple pictures)
K, ≡, ! video synthesizer: K clear, ≡ adjust intensity, ! redraw
# connect a foreign video switch line to a given channel
W, Z, ⊗, $, 0 geometric. W window, Z size, ⊗ shrink, $ general, 0 interpolating
shrink
Y, U, \ Y fix vert sync, U remove black border, \ wipe out a patch
F, L, N, V, ~ filter the picture
F high pass, L low pass, N remove noise, V interest, ~ dequantize
& measure noise figure of picture
G, J graph the numbers of each grey level. G raw, J integrated
E enhance a picture (normalize the instances of each grey level)
M modify grey levels via a function (entered piecewise linear)
∞ enter extended mode (∞? gives extended mode help)
Q quit
Combine commands with ↔ for <cr>. @FILE reads commands from a file.
");
END;
["←"] comment alter camera number;
BEGIN
UOUTSTR(" CHANNEL NUMBER:");
CAMERA←CVO(UINCHWL);
BCL←7; TCL←0;
END;
["I"] comment input a file;
BEGIN
OWN STRING FN;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("");
IF LENGTH(FN)>0 THEN PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
PWANT←PFLDIM(FN);
BACKLOG←"I"&FN;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END
ELSE
BEGIN
GETPFL(BACKLOG,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
BACKLOG←"";
INITED←FALSE;
FN←DEVPRS&":"&FILPRS;
END;
END;
["⊂"] comment input a raw byte buffer file;
BEGIN
OWN STRING FN; STRING S; OWN INTEGER FOO,H,W,B;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:"); FN←UINCHWL;
UOUTSTR("LINES, BYTES/LINE, BITS/BYTE:");
S←UINCHWL;
H←INTSCAN(S,FOO);
W←INTSCAN(S,FOO);
B←INTSCAN(S,FOO);
PWANT←PIXDIM(H,W,B);
BACKLOG←"⊂"&FN;
END
ELSE
BEGIN
INTEGER XXEOF,XXCOUNT,XXBRCHAR,XXFLAG;
PRSFIL(FN);
MAKPIX(H,W,B,PIC[0]);
XXEOF←TRUE;
OPEN(10,DEVPRS,'10,19,0,XXCOUNT,XXBRCHAR,XXEOF);
IF ¬XXEOF THEN LOOKUP(10,FILPRS,XXFLAG);
IF XXFLAG ∨ XXEOF THEN
BEGIN
RELEASE(10);
PRINT("aborted",'15&'12);
END
ELSE
BEGIN
ARRYIN(10,MEMORY[PIC[LINTAB]],PIC[PCWD]);
RELEASE(10);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END;
BACKLOG←"";
INITED←FALSE;
FN←DEVPRS&":"&FILPRS;
END;
END;
["β"] comment input a font character;
BEGIN
OWN STRING FN; OWN INTEGER CHR,RASH,RASW,ICHAN,NWORD;
REQUIRE "PGFAI.REL[GOD,HPM]" LOAD_MODULE;
EXTERNAL PROCEDURE L1X1(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
BOOLEAN PROCEDURE FNTSEL;
BEGIN "FNTSEL"
INTEGER FOO,IFLAG,I,J,POS;
INTEGER ARRAY FHD[0:'205];
PRSFIL(FN);
ICHAN←GETCHAN;
IFLAG←TRUE;
OPEN(ICHAN,DEVPRS,'10,19,0,FOO,FOO,IFLAG);
LOOKUP(ICHAN,FILPRS,IFLAG);
IF IFLAG THEN BEGIN RELEASE(ICHAN); RETURN(FALSE); END;
ARRYIN(ICHAN,FHD[0],'204);
UOUTSTR("CHARACTER:"); CHR←UINCHRW;
POS←FHD[CHR] LAND '777777;
USETI(ICHAN,POS%128 + 1);
FOR I←(POS MOD 128) STEP -1 UNTIL 1 DO WORDIN(ICHAN);
RASW←WORDIN(ICHAN); NWORD←RASW LAND '777777;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←FHD[CHR] LSH -18;
RASH←WORDIN(ICHAN) LAND '777777;
RETURN(TRUE);
END "FNTSEL";
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("");
PRSFIL("DSK:.FNT[XGP,SYS]");
IF LENGTH(FN)>0 THEN PRSFIL(FN);
UOUTSTR("FONT:");
IF LENGTH(FN←UINCHWL)>0 ∧ FNTSEL THEN
IF RASW*RASH>0 THEN
BEGIN
PWANT←PIXDIM(RASH,RASW,1);
BACKLOG←"β"&FN;
END
ELSE
BEGIN
PRINT("no letter ",CHR&'15&'12);
FN←DEVPRS&":"&FILPRS;
END
ELSE PRINT("aborted ",DEVPRS,":",FILPRS,'15&'12);
END
ELSE
BEGIN
INTEGER ARRAY PERM[0:1], CHAR[-1:NWORD-2];
MAKPIX(RASH,RASW,1,PIC[0]);
WIPE(PIC[0],0);
CHAR[-1]←(RASW MIN 511) LSH 27;
CHAR[0]←RASH;
ARRYIN(ICHAN,CHAR[1],NWORD-2); RELEASE(ICHAN);
L1X1(PIC[0],0,0,CHAR[-1]);
PERM[0]←1; PERM[1]←0;
PERBIT(PIC[0],PERM[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
BACKLOG←"";
INITED←FALSE;
FN←DEVPRS&":"&FILPRS;
END;
END;
["+"] comment add an input a file;
BEGIN
OWN STRING FN;
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY T[0:PFLDIM(FN)];
GETPFL(FN,T[0]);
PICADD(T[0],PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
FN←DEVPRS&":"&FILPRS;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["*"] comment multiply by an input a file;
BEGIN
OWN STRING FN;
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY T[0:PFLDIM(FN)];
GETPFL(FN,T[0]);
PICMUL(T[0],PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
FN←DEVPRS&":"&FILPRS;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["%"] comment give information about a file;
BEGIN
OWN STRING FN;
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY HD[0:10];
GETPFD(FN,HD[0]);
PRINT(HD[PCLN]," LINES x ",HD[LNBY],
" BYTES/LINE x ",HD[BYBI]," BITS/BYTE",'15&'12);
FN←DEVPRS&":"&FILPRS;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["/"] comment input a portion of a file;
BEGIN
OWN STRING FN; STRING INFL; OWN INTEGER LY,LX,HY,HX,XCMP,YCMP,BT;
INTEGER FOO; REAL A,B;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY HD[0:10];
GETPFD(FN,HD[0]);
PRINT(HD[PCLN]," LINES x ",HD[LNBY],
" BYTES/LINE x ",HD[BYBI]," BITS/BYTE",'15&'12);
UOUTSTR("LOW Y, HIGH Y:"); INFL←UINCHWL;
LY←A←REALSCAN(INFL,FOO);
HY←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
LY←A*HD[PCLN];
HY←B*HD[PCLN];
END;
IF LY>HY THEN LY↔HY;
LY←LY MAX 0; HY←HY MIN (HD[PCLN]-1);
UOUTSTR("LOW X, HIGH X:"); INFL←UINCHWL;
LX←A←REALSCAN(INFL,FOO);
HX←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
LX←A*HD[LNBY];
HX←B*HD[LNBY];
END;
IF LX>HX THEN LX↔HX;
LX←LX MAX 0; HX←HX MIN (HD[LNBY]-1);
UOUTSTR("COMPRESSION FACTORS (Y, X):"); INFL←UINCHWL;
YCMP←INTSCAN(INFL,FOO);
XCMP←INTSCAN(INFL,FOO);
YCMP←YCMP MAX 1;
IF XCMP≤0 THEN XCMP←YCMP;
HY←(HY-LY+1)%YCMP; HX←(HX-LX+1)%XCMP;
IF HY=0 THEN HY←256; IF HX=0 THEN HX←256;
HY←(HY MAX 1) MIN (HD[PCLN]-LY)%YCMP;
HX←(HX MAX 1) MIN (HD[LNBY]-LX)%XCMP;
UOUTSTR("BITS PER SAMPLE:"); INFL←UINCHWL;
BT←INTSCAN(INFL,FOO); IF BT=0 THEN BT←HD[BYBI];
BT←(BT MAX 1) MIN 36;
PWANT←PIXDIM(HY,HX,BT);
BACKLOG←"/"&FN;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END
ELSE
BEGIN
FN←DEVPRS&":"&FILPRS;
MAKPIX(HY,HX,BT,PIC[0]);
GETPFP(BACKLOG,PIC[0],LY,LX,YCMP,XCMP);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
BACKLOG←"";
INITED←FALSE;
END;
END;
["O"] comment output a file;
BEGIN
OWN STRING FN;
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)≠0 THEN
BEGIN
PUTPFL(PIC[0],FN);
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
PRINT("[",PIC[PCLN]," lines * ",PIC[LNBY]," bytes * ",PIC[BYBI]," bits/byte]
");
END
ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["¬"] comment output a 1 bit picture to the XGP;
BEGIN
OWN STRING S; INTEGER FOO;
UOUTSTR("Top margin, left margin (in pixels):"); S←UINCHWL;
VIDXGP(PIC[0],REALSCAN(S,FOO),REALSCAN(S,FOO),2200);
END;
["D"]["∂"]["∧"] comment video synthesizer display;
BEGIN
INTEGER I,J;
EXTERNAL REAL XL,XSC,YH,YSC;
REAL SX,SY,ASP,ASPEN;
REAL PX,PY; INTEGER MODP;
SYNLAS←TRUE;
MODP←SYPOS MOD (SDISWID*SDISHIG);
PX←MODP MOD SDISWID;
MODP←MODP%SDISWID;
PY←SDISHIG-MODP-1;
PX←2*PX-SDISWID+1;
PY←2*PY-SDISHIG+1;
SX←1; SY←1; ASPEN←SASPECT*SDISWID/SDISHIG;
ASP←PIC[PCLN]/PIC[LNBY];
IF ASP>ASPEN THEN SX←ASPEN/ASP ELSE SY←ASP/ASPEN;
SX←SX*SSIZE; SY←SY*SSIZE;
SETFORMAT(0,2);
SCREEN(-SDISWID,-SDISHIG,SDISWID,SDISHIG);
IF CHR="∧" THEN MAPMON(MAPTF)
ELSE BEGIN MAPGRY(MAPTF,MAPBT); GRAY(PIC[0]) END;
I←PIC[BYBI];
IF SYNMAP(I)>0 ∨ SDISHIG*SDISWID>1 THEN
BEGIN
IF SDISHIG*SDISWID>1 THEN GETDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
VID(PX-SX,PY-SY,PX+SX,PY+SY,PIC[0],1);
LXB←((PX-SX)-XL)*XSC;
UXB←((PX+SX)-XL)*XSC;
LYB←((PY+SY)-YH)*YSC;
UYB←((PY-SY)-YH)*YSC;
IF CHR="∂" THEN
BEGIN
REAL X1,Y1,X2,Y2;
INTEGER I;
LITEN;
SCREEM(X1,Y1,X2,Y2);
SCREEN(0,480,511,0);
FOR I←0 STEP 1 UNTIL 10 DO
BEGIN
LINE(LXB+(UXB-LXB)*I/10,LYB,LXB+(UXB-LXB)*I/10,UYB);
LINE(LXB,LYB+(UYB-LYB)*I/10,UXB,LYB+(UYB-LYB)*I/10);
END;
SCREEN(X1,Y1,X2,Y2);
END;
IF SYNMAP(I)>0 THEN
BEGIN
ERASE(SYNMAP(I));
FOR J←1,1 DO DPYUP(SYNMAP(I));
END;
IF SDISHIG*SDISWID>1 THEN PUTDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
END;
FOR I←PIC[BYBI]-1 STEP -1 UNTIL 0 DO
IF SYNMAP(I)>0 ∨ SDISHIG*SDISWID>1 THEN
BEGIN
IF SDISHIG*SDISWID>1 THEN GETDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
VID(PX-SX,PY-SY,PX+SX,PY+SY,
PIC[0],1 LSH (PIC[BYBI]-1-I));
LXB←((PX-SX)-XL)*XSC;
UXB←((PX+SX)-XL)*XSC;
LYB←((PY+SY)-YH)*YSC;
UYB←((PY-SY)-YH)*YSC;
IF CHR="∂" THEN
BEGIN
REAL X1,Y1,X2,Y2;
INTEGER I;
LITEN;
SCREEM(X1,Y1,X2,Y2);
SCREEN(0,480,511,0);
FOR I←0 STEP 1 UNTIL 10 DO
BEGIN
LINE(LXB+(UXB-LXB)*I/10,LYB,LXB+(UXB-LXB)*I/10,UYB);
LINE(LXB,LYB+(UYB-LYB)*I/10,UXB,LYB+(UYB-LYB)*I/10);
END;
SCREEN(X1,Y1,X2,Y2);
END;
IF SYNMAP(I)>0 THEN
BEGIN
ERASE(SYNMAP(I));
FOR J←1,1 DO DPYUP(SYNMAP(I));
END;
IF SDISHIG*SDISWID>1 THEN PUTDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
END;
IF CHR ≠ "∧" THEN UNGRAY(PIC[0]);
HAFTONE←TRUE;
SYPOS←SYPOS+1;
OUTSTR("*");
SHOWA('47);
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
END;
["!"] comment redraw old video synthesizer display;
BEGIN
INTEGER I;
MAPGRY(MAPTF,8);
FOR I←7 STEP -1 UNTIL 0 DO
IF SYNMAP(I)≥0 THEN
BEGIN
GETDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
ERASE(SYNMAP(I));
DPYUP(SYNMAP(I));
END;
SHOWA('47);
HAFTONE←TRUE;
END;
["∃"] comment quick and dirty video synthesizer display;
BEGIN
INTEGER I,J;
SYNLAS←TRUE;
SETFORMAT(0,2);
SCREEN(-SDISWID,-SDISHIG,SDISWID,SDISHIG);
MAPGRY(MAPTF,PIC[BYBI]); GRAY(PIC[0]);
FOR I←PIC[BYBI]-1 STEP -1 UNTIL 0 DO
IF SYNMAP(I)>0 THEN
BEGIN
DRKEN; RECTAN(-100,-100,100,100);
VIDONE(PIC[0],1 LSH (PIC[BYBI]-1-I),
LYB←(481-(PIC[PCLN] MIN 481))%2,
LXB←(512-(PIC[LNBY] MIN 512))%2);
LXB←LXB-(LXB MOD 32);
UYB←(LYB+PIC[PCLN]-1) MIN 480;
UXB←(LXB+PIC[LNBY]-1) MIN 511;
IF SYNMAP(I)>0 THEN
BEGIN
ERASE(SYNMAP(I));
DPYUP(SYNMAP(I));
END;
END;
UNGRAY(PIC[0]);
HAFTONE←TRUE;
OUTSTR("*");
SHOWA('47);
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
END;
["H"]["R"]["A"] comment some kind of halftone;
BEGIN
EXTERNAL REAL XL,XSC,YH,YSC;
INTEGER J,CHN;
REAL SX,SY,ASP,ASPEN;
REAL PX,PY; INTEGER MODP;
SYNLAS←FALSE;
MODP←HAPOS MOD (HDISWID*HDISHIG);
PX←MODP MOD HDISWID;
MODP←MODP%HDISWID;
PY←HDISHIG-MODP-1;
PX←2*PX-HDISWID+1;
PY←2*PY-HDISHIG+1;
SX←1; SY←1; ASPEN←HASPECT*HDISWID/HDISHIG;
ASP←PIC[PCLN]/PIC[LNBY];
IF ASP>ASPEN THEN SX←ASPEN/ASP ELSE SY←ASP/ASPEN;
SX←SX*HSIZE; SY←SY*HSIZE;
SCREEN(-HDISWID,-HDISHIG,HDISWID,HDISHIG);
IF HDISHIG*HDISWID>1 THEN GETDDF("DSK:DD.TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
IF CHR = "H" THEN comment high-quality;
VIDEO(PX-SX,PY-SY,PX+SX,PY+SY,PIC[0],-2)
ELSE IF CHR = "R" THEN comment random;
VID(PX-SX,PY-SY,PX+SX,PY+SY,PIC[0],-1)
ELSE IF CHR = "A" THEN comment "arty" (bug);
VIDEO(PX-SX,PY-SY,PX+SX,PY+SY,PIC[0],-4);
LXB←((PX-SX)-XL)*XSC;
UXB←((PX+SX)-XL)*XSC;
LYB←((PY+SY)-YH)*YSC;
UYB←((PY-SY)-YH)*YSC;
CHN←GDDCHN(-1);
ERASE(CHN);
DPYUP(CHN);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
SHOWA(CHN);
HAFTONE←TRUE;
IF HDISHIG*HDISWID>1 THEN PUTDDF("DSK:DD.TMP[TMP,HPM]");
HAPOS←HAPOS+1;
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
RDDCHN(CHN);
END;
["∀"] comment simple halftone display;
BEGIN
INTEGER J,CHN,FOO; STRING S;
REAL SX,SY,PX,PY;
SYNLAS←FALSE;
SCREEN(0,480,511,0);
LITEN; RECTAN(-1000,-1000,1000,1000);
UOUTSTR("HEIGHT, WIDTH (IN DD PIXELS):");
SY←REALSCAN(S←UINCHWL,FOO);
SX←REALSCAN(S,FOO);
PX←(512-SX)/2;
PY←(481-SY)/2;
DRKEN; RECTAN(PX,PY,PX+SX,PY+SY);
VIDEO(LXB←PX,UYB←PY+SY,UXB←PX+SX,LYB←PY,PIC[0],-2);
CHN←GDDCHN(-1);
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
SHOWA(CHN);
HAFTONE←TRUE;
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
RDDCHN(CHN);
END;
["X"] comment send previous halftone to the XGP;
BEGIN
INTEGER J;
UOUTSTR("SIZE (-5 to +5):");
J←CVD(UINCHWL);
IF J≠0 THEN
BEGIN
IF HAFTONE THEN BEGIN INVEN; RECTAN(-1000,-1000,1000,1000); END;
XGPQUE(J);
IF HAFTONE THEN BEGIN INVEN; RECTAN(-1000,-1000,1000,1000); END;
END
ELSE
OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
[">"] comment make a DD buffer into an MIT transferrable file;
BEGIN
OWN STRING FN;
PRSFIL("");
PRSFIL("DSK:.SU");
IF LENGTH(FN)>0 THEN PRSFIL(FN);
UOUTSTR("OUTPUT FILE NAME:");
IF ¬PUTMIT(UINCHWL) THEN OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12)
ELSE
BEGIN
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
END;
["<"] comment display MIT transferrable file;
BEGIN
OWN STRING FN;
INTEGER J,CHN;
PRSFIL("");
PRSFIL("DSK:.MIT");
IF LENGTH(FN)>0 THEN PRSFIL(FN);
UOUTSTR("INPUT FILE NAME:");
DRKEN; RECTAN(-100,-100,100,100);
IF ¬GETMIT(UINCHWL) THEN OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12)
ELSE
BEGIN
CHN←GDDCHN(-1);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
SHOWA(CHN);
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
FN←DEVPRS&":"&FILPRS;
END;
END;
["#"] comment switch a video switch output;
BEGIN
INTEGER J,K;
UOUTSTR(" LINE:"); J←CVO(UINCHWL);
UOUTSTR("CHANNEL:"); K←CVO(UINCHWL);
SHOW(K,J);
END;
["P"] comment list a picture on the tty;
BEGIN
INTEGER I,J,K,L,M;
REAL ASP;
INTEGER SX,SY;
ASP←PIC[PCLN]/PIC[LNBY];
SX←TWID; SY←SX*ASP*TASPECT;
IF SY>TLEN THEN BEGIN SX←SX*TLEN/SY; SY←TLEN; END;
BEGIN
REAL PCMAX;
PCMAX←2↑PIC[BYBI]-1;
CALL(0,"RESET");
OUTSTR('15&'12);
FOR J←0 STEP 1 UNTIL SY-1 DO
BEGIN
FOR I←0 STEP 1 UNTIL SX-1 DO
BEGIN
PRELOAD_WITH " ","`",".","-","'","/",":","+","1","[","0",
"X","%","A","Q","M","*";
OWN INTEGER ARRAY GRT[0:16];
IF TBRITE THEN
OUTSTR(GRT[16*PIXEL(PIC[0],PIC[PCLN]*J%SY,PIC[LNBY]*I%SX)/PCMAX])
ELSE
OUTSTR(GRT[16*
(1-PIXEL(PIC[0],PIC[PCLN]*J%SY,PIC[LNBY]*I%SX)/PCMAX)]);
END;
OUTSTR('15&'12);
END;
END;
END;
["α"] comment add a letter to a font;
BEGIN
INTEGER LETR,FOO; OWN STRING FOFIL; STRING INS; REAL BAS;
REAL X1,X2,Y1,Y2;
SCREEM(X1,Y1,X2,Y2);
SCREEN(0,480,511,0);
PRSFIL(""); PRSFIL(".FNT");
IF LENGTH(FOFIL)>0 THEN PRSFIL(FOFIL);
UOUTSTR("FONT FILE:"); FOFIL←UINCHWL;
PRSFIL(FOFIL);
UOUTSTR("LETTER:"); LETR←UINCHWL;
UOUTSTR("BASELINE (FRACTION OF HEIGHT):"); INS←UINCHWL;
BAS←REALSCAN(INS,FOO);
IF HAFTONE THEN BEGIN INVEN; RECTAN(LXB,LYB,UXB,UYB); END;
DDFONT(LXB,UYB,UXB,LYB, FOFIL, LETR, ABS(UYB-LYB)*BAS);
IF HAFTONE THEN BEGIN INVEN; RECTAN(LXB,LYB,UXB,UYB); END;
SCREEN(X1,Y1,X2,Y2);
FOFIL←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
["λ"] comment make an XGPable or editable file;
BEGIN
INTEGER I,J,K,L,M,CHN,WIDTH,DIGITS,NEWWID,BIAS;
REAL D,G,O; STRING S,FMT; OWN STRING FN;
IF LENGTH(FN)>0 THEN PRSFIL(FN);
FMT←"";
DO
BEGIN
UOUTSTR("Output file format (x=xgp,d=decimal,o=octal,a=alphatype):");
FMT←UCONV(UINCHRW);
END
UNTIL FMT="X" ∨ FMT="D" ∨ FMT="O" ∨ FMT="A";
PRSFIL("");
IF FMT="A" THEN PRSFIL(".DVI") ELSE PRSFIL(".TXT");
DO
BEGIN
UOUTSTR("Output file name:");
FN←UINCHWL;
IF LENGTH(FN)>0 THEN PRSFIL(FN);
M←1;
CHN←GETCHAN;
OPEN(CHN,DEVPRS,(IF FMT="A" THEN '10 ELSE 0),0,19,0,0,M);
ENTER(CHN,FILPRS,M);
IF M THEN UOUTSTR("File "&DEVPRS&":"&FILPRS&" cannot be created."&'15&'12);
END
UNTIL ¬M;
CASE FMT OF
BEGIN "FORMAT"
["X"] comment xgp format;
BEGIN
UOUTSTR("DENSITY (0 (normal) to 1):"); D←REALSCAN(S←UINCHWL,M);
O←'77+'40*D; G←(D+1)*'40/(1+PIC[BMAX]);
FOR I←0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
FOR J←0 STEP 1 UNTIL PIC[LNBY]-1 DO
OUT(CHN,M←O-G*PIXEL(PIC[0],I,J));
OUT(CHN,'15&'12);
END;
END;
["D"] comment decimal format;
BEGIN
GETFORMAT(WIDTH,DIGITS);
SETFORMAT(0,DIGITS);
NEWWID←LENGTH(CVS(PIC[BMAX]));
OUT(CHN,"λ FMT D BYBI " & CVS(PIC[BYBI]) &
" CHRS " & CVS(NEWWID));
OUT(CHN,'15&'12);
SETFORMAT(NEWWID,DIGITS);
DO
BEGIN
UOUTSTR("Subtract bias? (y/n): ");
S←UCONV(UINCHRW);
END
UNTIL S="Y" ∨ S="N";
BIAS← IF S="Y" THEN 2↑(PIC[BYBI]-1) ELSE 0;
FOR I←0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
FOR J←0 STEP 1 UNTIL PIC[LNBY]-1 DO
OUT(CHN,CVS(PIXEL(PIC[0],I,J)-BIAS)&" ");
OUT(CHN,'15&'12);
END;
SETFORMAT(WIDTH,DIGITS);
END;
["O"] comment octal format;
BEGIN
GETFORMAT(WIDTH,DIGITS);
SETFORMAT(0,DIGITS);
NEWWID←LENGTH(CVS(PIC[BMAX]));
OUT(CHN,"λ FMT O BYBI " & CVS(PIC[BYBI]) &
" CHRS " & CVS(NEWWID));
OUT(CHN,'15&'12);
SETFORMAT(NEWWID,DIGITS);
FOR I←0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
FOR J←0 STEP 1 UNTIL PIC[LNBY]-1 DO
OUT(CHN,CVOS(PIXEL(PIC[0],I,J))&" ");
OUT(CHN,'15&'12);
END;
SETFORMAT(WIDTH,DIGITS);
END;
["A"] comment .dvi file for alphatype;
BEGIN
INTEGER OUTWD,SHIFTCOUNT,BYTECOUNT;
STRING FONT;
DEFINE HALFBITS = "6"; Comment bits per halftone pixel;
DEFINE HALFMASK = "'77"; Comment 2↑HALFBITS - 1;
DEFINE BOP = "129"; Comment beginning of page command;
DEFINE FONTZERO = "154"; Comment set font zero command;
DEFINE PUSH = "132"; Comment alphatype push command;
DEFINE POP = "133"; Comment alphatype pop command;
DEFINE Y4 = "146"; Comment alphatype verticle move;
DEFINE EOP = "130"; Comment end of page;
DEFINE PST = "131"; Comment postamble;
DEFINE PAD = "223"; Comment silly crud;
COMMENT An RSU is 10e-7 meters. There are 47.625 RSU's per alphatype pixel.
Halftone fonts are sixty by sixty pixel squares.;
DEFINE VERTMOVE = "2875"; Comment vertical line spacing;
DEFINE HEIGHT = "PIC[PCLN]*VERTMOVE"; Comment page height in RSU;
DEFINE WIDTH = "PIC[LNBY]*VERTMOVE"; Comment page width in RSU;
DEFINE LINELIMIT = "(5000 DIV PIC[LNBY])"; Comment 5000 chars per page;
INTEGER POSTADRS; Comment postamble address (in DVI file);
INTEGER SCAN;
INTEGER BACKPTR; Comment Used for linking dvi pages together;
PROCEDURE OUTBYTE(INTEGER BYTE);
BEGIN
IF (SHIFTCOUNT←SHIFTCOUNT + 1) ≤ 4 THEN
OUTWD ← (OUTWD LSH 8) LOR (BYTE LAND '377)
ELSE
BEGIN
WORDOUT(CHN,OUTWD LSH 4);
OUTWD←BYTE LAND '377;
SHIFTCOUNT←1
END;
BYTECOUNT←BYTECOUNT+1;
END;
PROCEDURE OUTWORD(INTEGER WORD);
BEGIN
INTEGER I;
FOR I ← -24 STEP 8 UNTIL 0 DO OUTBYTE(WORD LSH I);
END;
PROCEDURE OUTSTRING(STRING S);
BEGIN
INTEGER I;
STRING IT; Comment dont mess with the original;
IT ← S;
FOR I ← 1 STEP 1 UNTIL LENGTH(S) DO
OUTBYTE(LOP(IT));
END;
PROCEDURE FINISH;
BEGIN
Comment Dont do anything - yes the last word doesnt get
sent to disk. That is essential since DVI
cant have any trailing bytes except 223's;
END;
PROCEDURE DOLINE(INTEGER LINE);
BEGIN
INTEGER I;
FOR I←0 STEP 1 UNTIL PIC[LNBY]-1 DO
BEGIN
OUTBYTE((PIXEL(PIC[0],LINE,I) LSH (HALFBITS-PIC[BYBI])) LAND
HALFMASK);
END;
END;
PROCEDURE MAKEPAGE(INTEGER LINE);
BEGIN
INTEGER WORTHLESS, PAGEADDR;
OUTBYTE(BOP);
PAGEADDR←BYTECOUNT; Comment save page address for later;
FOR WORTHLESS ← 1 STEP 1 UNTIL 10 DO OUTWORD(0);
OUTWORD(BACKPTR); Comment output backpointer;
BACKPTR←PAGEADDR; Comment Save address of this page;
OUTBYTE(FONTZERO);
OUTBYTE(Y4);
OUTWORD(LINE*VERTMOVE);
OUTBYTE(PUSH);
END;
PROCEDURE ENDPAGE;
BEGIN
OUTBYTE(POP); Comment Remove the vertical position;
OUTBYTE(EOP);
END;
PROCEDURE ADVANCE;
BEGIN
OUTBYTE(POP);
OUTBYTE(Y4);
OUTWORD(VERTMOVE);
OUTBYTE(PUSH);
END;
PROCEDURE POSTAMBLE;
BEGIN
OUTBYTE(PST);
POSTADRS ← BYTECOUNT; Comment save address of postamble;
OUTWORD(BACKPTR); Comment point to previous BOP;
OUTWORD(1); Comment n parameter;
OUTWORD(1); Comment d parameter;
OUTWORD(1000); Comment magnification;
OUTWORD(HEIGHT); OUTWORD(WIDTH); Comment utterly pointless;
Comment font directory;
OUTWORD(0); Comment font number;
OUTWORD(0); Comment font checksum;
OUTWORD(1000); Comment magnificatiion;
FONT ← "HF60"; Comment 60x60 font file name;
OUTBYTE(LENGTH(FONT));Comment length of font file name;
OUTSTRING(FONT);
OUTWORD(-1); Comment end of fonts;
OUTWORD(POSTADRS);
OUTBYTE(1); Comment id code;
OUTBYTE(PAD); OUTBYTE(PAD); OUTBYTE(PAD); OUTBYTE(PAD);
OUTBYTE(PAD); OUTBYTE(PAD); OUTBYTE(PAD); OUTBYTE(PAD);
OUTBYTE(PAD); OUTBYTE(PAD); OUTBYTE(PAD); OUTBYTE(PAD);
END;
SHIFTCOUNT ← 0; OUTWD ← 0; Comment initialize byte output;
BACKPTR ← BYTECOUNT ← -1;
UOUTSTR("MAKING .DVI FILE" & '15 & '12);
MAKEPAGE(0); Comment produce the header stuff;
DOLINE(0); Comment typeset the first line of picture;
FOR SCAN ← 1 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
IF (SCAN MOD LINELIMIT) = 0 THEN Comment Keep pages small;
BEGIN
ENDPAGE;
MAKEPAGE(SCAN);
END
ELSE
ADVANCE;
DOLINE(SCAN);
END;
ENDPAGE;
POSTAMBLE; Comment write the postamble;
FINISH;
END
END "FORMAT";
CLOSE(CHN); RELEASE(CHN);
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
["{"] comment read in a λ'd (XGPable) file;
BEGIN
OWN STRING FN,FMT;
OWN INTEGER EOF,CHN,LWID,LHIG,LBIT,BYCHRS,BIAS;
INTEGER I,J; STRING S;
RECURSIVE INTEGER PROCEDURE OCTSCAN
(REFERENCE STRING S;REFERENCE INTEGER BRCHAR);
BEGIN "OCTSCAN"
STRING SUBST;
SUBST←SCAN(S,3,BRCHAR);
RETURN(IF LENGTH(SUBST)>0 THEN CVO(SUBST) ELSE OCTSCAN(S,BRCHAR));
END "OCTSCAN";
STRING PROCEDURE lopspace(REFERENCE STRING s);
comment flush leading spaces in s;
BEGIN "lopspace"
STRING foo;
WHILE EQU(" ",s[1 TO 1]) ∨ EQU('11,s[1 TO 1]) DO foo←LOP(s);
RETURN(s);
END "lopspace";
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("");
PRSFIL(".TXT");
IF LENGTH(FN)>0 THEN PRSFIL(FN);
DO
BEGIN
UOUTSTR("TEXT INPUT FILE NAME:");
FN←UINCHWL;
IF LENGTH(FN)>0 THEN PRSFIL(FN);
EOF←TRUE;
CHN←GETCHAN;
OPEN(CHN,DEVPRS,0,19,0,1024,0,EOF);
LOOKUP(CHN,FILPRS,EOF);
END
UNTIL ¬EOF;
BREAKSET(1,'15&'14&'13,"I");
BREAKSET(1,'12,"O");
BREAKSET(3,'15&'14&'13&" ","I");
BREAKSET(3,'12,"O");
SETBREAK(2,NULL,NULL,"XA"); comment everything is break & kept;
IF INPUT(CHN,2)="λ" THEN
BEGIN
OWN INTEGER tempwid;
FOR I←1 STEP 1 UNTIL 6 DO INPUT(CHN,2);
FMT←INPUT(CHN,2);
LBIT←INTIN(CHN);
INTIN(CHN); comment bychrs slot;
lhig←lwid←0;
WHILE TRUE DO
BEGIN
REQUIRE "{}<>" DELIMITERS;
DEFINE increment(foo)={foo←foo+1};
REQUIRE UNSTACK_DELIMITERS;
S←INPUT(chn,1);
IF eof THEN DONE;
increment(lhig);
tempwid←0;
WHILE LENGTH(S)>0 DO
BEGIN INTSCAN(S,0); increment(tempwid);s←lopspace(s); END ;
lwid←lwid max tempwid;
END;
END
ELSE
BEGIN
USETI(CHN,1);
FMT←"X";
LBIT←6;
LHIG←-1; LWID←0;
WHILE ¬EOF DO
BEGIN
LHIG←LHIG+1;
LWID←LWID MAX LENGTH(INPUT(CHN,1));
END;
END;
FN←DEVPRS&":"&FILPRS;
PWANT←PIXDIM(LHIG,LWID,LBIT);
BACKLOG←"{ ";
END
ELSE
BEGIN
BOOLEAN LOPP;
MAKPIX(LHIG,LWID,LBIT,PIC[0]);
WIPE(PIC[0],-1);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
USETI(CHN,1);
LOPP←FALSE;
IF FMT="D" ∨ FMT="O" THEN
BEGIN
INPUT(CHN,1);
LOPP←TRUE;
DO
BEGIN
UOUTSTR("Add bias? (y/n): ");
S←UINCHRW;
IF S="y" THEN S←"Y" ELSE IF S="n" THEN S←"N";
END
UNTIL S="Y" ∨ S="N";
BIAS← IF S="Y" THEN 2↑(PIC[BYBI]-1) ELSE 0;
END;
FOR I←0 STEP 1 UNTIL LHIG-1 DO
BEGIN
S←INPUT(CHN,1); J←-1;
WHILE LENGTH(IF LOPP THEN LOPSPACE(S) ELSE S)>0 DO
PUTEL(PIC[0],I,J←J+1,IF FMT="X" THEN '137-LOP(S)
ELSE IF FMT="D" THEN INTSCAN(S,0)+BIAS
ELSE IF FMT="O" THEN OCTSCAN(S,0)+BIAS
ELSE 0);
END;
BACKLOG←"";
INITED←FALSE;
CLOSE(CHN); RELEASE(CHN);
END;
END;
["C"] comment step past a certain number of pictures;
BEGIN
INTEGER T;
UOUTSTR("SKIP HOW MANY (NEGATIVE TO BACKSPACE):");
T←CVD(UINCHWL);
IF SYNLAS THEN SYPOS←SYPOS+T ELSE HAPOS←HAPOS+T;
END;
["K"] comment clear the video synthesizer;
BEGIN
INTEGER T;
FOR T←0 STEP 1 UNTIL 7 DO ERASE(SYNMAP(T));
END;
["≡"] comment gronk synthesizer intensity table;
BEGIN
STRING SI; INTEGER I;
UOUTSTR("TRANSFER FUNCTION (about -2.0 to 2.0):");
IF ¬MAPGRY(MAPTF←REALSCAN(SI←UINCHWL,I),MAPBT) THEN
OUTSTR("failed"&'15&'12);
END;
["S"] comment change size of displays;
BEGIN
STRING INP; INTEGER FOO,INC;
REAL T;
UOUTSTR("For Synthesizer, Halftones, Grinnell, or Printout "&
"(S, H, G OR P)?");
INC←UCONV(UINCHRW);
IF INC="S" THEN
BEGIN
INTEGER I;
SYNLAS←TRUE;
SETFORMAT(0,2);
UOUTSTR("PICTURE SIZE (1 IS FULLSIZE, NOW"&CVF(SSIZE)&"):"); INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN SSIZE←ABS(T);
UOUTSTR("ASPECT RATIO (HEIGHT/WIDTH OF SCREEN, NOW"&CVF(SASPECT)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T>0 THEN SASPECT←T;
UOUTSTR("PICTURES IN X (NOW "&CVS(SDISWID)&"):");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠SDISWID THEN
BEGIN
SDISWID←T;
SYPOS←0;
END;
UOUTSTR("PICTURES IN Y (NOW "&CVS(SDISHIG)&"):");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠SDISHIG THEN
BEGIN
SDISHIG←T;
SYPOS←0;
END;
SCREEN(-1,-1,1,1);
DRKEN; RECTAN(-1000,-1000,1000,1000);
IF SDISHIG*SDISWID>1 THEN
BEGIN
UOUTSTR("ERASE?");
IF UCONV(UINCHWL)="Y" THEN
FOR I←0 STEP 1 UNTIL 7 DO
PUTDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
END;
END
ELSE IF INC="H" THEN
BEGIN
SYNLAS←FALSE;
SETFORMAT(0,2);
UOUTSTR("PICTURE SIZE (1 IS FULLSIZE, NOW"&CVF(HSIZE)&"):"); INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN HSIZE←ABS(T);
UOUTSTR("ASPECT RATIO (HEIGHT/WIDTH OF SCREEN, NOW"&CVF(HASPECT)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T>0 THEN HASPECT←T;
UOUTSTR("PICTURES IN X (NOW "&CVS(HDISWID)&"):");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠HDISWID THEN
BEGIN
HDISWID←T;
HAPOS←0;
END;
UOUTSTR("PICTURES IN Y (NOW "&CVS(HDISHIG)&"):");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠HDISHIG THEN
BEGIN
HDISHIG←T;
HAPOS←0;
END;
SCREEN(-1,-1,1,1);
DRKEN; RECTAN(-1000,-1000,1000,1000);
IF HDISHIG*HDISWID>1 THEN PUTDDF("DSK:DD.TMP[TMP,HPM]");
END
ELSE IF INC="P" THEN
BEGIN
SETFORMAT(0,2);
UOUTSTR("Aspect ratio of tty (chrs/in, vertical/horizontal, now "&
CVF(TASPECT)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN TASPECT←ABS(T);
UOUTSTR("WIDTH OF TTY DISPLAYS (NOW "&CVS(TWID)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN TWID←ABS(T);
UOUTSTR("MAXIMUM HEIGHT OF TTY DISPLAYS (NOW "&CVS(TLEN)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN TLEN←ABS(T);
UOUTSTR("ARE LETTERS BRIGHT OR DARK (NOW "&
(IF TBRITE THEN "BRIGHT" ELSE "DARK")&"):");
TBRITE←¬(UCONV(UINCHWL)="D");
END
ELSE IF INC="G" THEN
BEGIN "SG"
SETFORMAT(0,0);
UOUTSTR("Channel (now "&CVS(GRNCHAN)&"):");
INP ← UINCHWL;
IF LENGTH(INP)≠0 THEN GRNCHAN ← CVD(INP);
END "SG";
END;
["F"] comment high pass filter;
BEGIN
INTEGER WINDOW;
UOUTSTR(" WINDOW SIZE:");
WINDOW←CVD(UINCHWL);
IF WINDOW>1 THEN
BEGIN
INTEGER ARRAY T[0:PHAVE];
PASSHI(PIC[0],WINDOW,T[0]);
ENHANCE(T[0]);
COPPIC(T[0],PIC[0]);
END
ELSE OUTSTR("window size must be >1"&'15&'12);
END;
["&"] comment measure noise;
BEGIN
OUTSTR(" NOISE FIGURE:"&CVF(NOISE(PIC[0]))&'15&'12);
END;
["⊗"] comment shrink the picture;
BEGIN
OWN INTEGER LHIG,LWID,LBIT,FX,FY;
INTEGER FOO; STRING INFL;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
UOUTSTR("SHRINK FACTORS (INTEGER) Y, X:"); INFL←UINCHWL;
FY←INTSCAN(INFL,FOO); FX←INTSCAN(INFL,FOO);
UOUTSTR("NUMBER OF BITS:"); LBIT←(CVD(UINCHWL) MIN 36);
IF LBIT≤0 THEN LBIT←PIC[BYBI];
IF FX≤0 THEN FX←1; IF FY≤0 THEN FY←1;
IF FX≠1∨FY≠1∨LBIT≠PIC[BYBI] THEN
BEGIN
LHIG←PIC[PCLN]%FY;
LWID←PIC[LNBY]%FX;
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBIT);
BACKLOG←"⊗ ";
END;
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("DSK:TMP.TMP[TMP,HPM]")];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(LHIG,LWID,LBIT,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
SQTILE(T[0],0,0,LHIG,LWID,FY,FX,PIC[0],0,0);
BACKLOG←"";
INITED←FALSE;
END;
END;
["L"] comment low pass filter;
BEGIN
LOWPAS(PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END;
["W"] comment select out a window;
BEGIN
INTEGER XL,XH,YL,YH,FOO; REAL A,B;
STRING INFL;
UOUTSTR("LOW Y, HIGH Y:"); INFL←UINCHWL;
YL←A←REALSCAN(INFL,FOO);
YH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
YL←A*PIC[PCLN];
YH←B*PIC[PCLN];
END;
IF YL>YH THEN YL↔YH;
YL←YL MAX 0; YH←YH MIN (PIC[PCLN]-1);
IF (YH-YL+1)>0 THEN
BEGIN
UOUTSTR("LOW X, HIGH X:"); INFL←UINCHWL;
XL←A←REALSCAN(INFL,FOO);
XH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
XL←A*PIC[LNBY];
XH←B*PIC[LNBY];
END;
IF XL>XH THEN XL↔XH;
XL←XL MAX 0; XH←XH MIN (PIC[LNBY]-1);
IF (XH-XL+1)>0 THEN
BEGIN
INTEGER ARRAY T[0:PIXDIM(YH-YL+1,XH-XL+1,PIC[BYBI])];
MAKPIX(YH-YL+1,XH-XL+1,PIC[BYBI],T[0]);
TILE(PIC[0],YL,XL,T[PCLN],T[LNBY],T[0],0,0);
COPPIC(T[0],PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
PWANT←PHAVE←PIXDIM(PIC[PCLN],PIC[LNBY],PIC[BYBI]);
INITED←FALSE;
END;
END;
END;
["\"] comment wipe out a window;
BEGIN
INTEGER XL,XH,YL,YH,FOO; REAL A,B;
STRING INFL;
UOUTSTR("LOW Y, HIGH Y:"); INFL←UINCHWL;
YL←A←REALSCAN(INFL,FOO);
YH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
YL←A*PIC[PCLN];
YH←B*PIC[PCLN];
END;
IF YL>YH THEN YL↔YH;
YL←YL MAX 0; YH←YH MIN (PIC[PCLN]-1);
IF (YH-YL+1)>0 THEN
BEGIN
UOUTSTR("LOW X, HIGH X:"); INFL←UINCHWL;
XL←A←REALSCAN(INFL,FOO);
XH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
XL←A*PIC[LNBY];
XH←B*PIC[LNBY];
END;
IF XL>XH THEN XL↔XH;
XL←XL MAX 0; XH←XH MIN (PIC[LNBY]-1);
IF (XH-XL+1)>0 THEN
BEGIN
INTEGER VAL,I,J;
OUTSTR("PIXEL VALUE:"); VAL←CVD(INCHWL);
FOR I←YL STEP 1 UNTIL YH DO
FOR J←XL STEP 1 UNTIL XH DO
PUTEL(PIC[0],I,J,VAL);
END;
END;
END;
["Z"] comment change size of a picture;
BEGIN
OWN INTEGER LHIG,LWID,LBIT;
INTEGER FOO;
STRING INFL;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
UOUTSTR("DILATION FACTORS (EG. .5 = HALF SIZE) Y, X:"); INFL←UINCHWL;
LHIG←ABS(REALSCAN(INFL,FOO))*PIC[PCLN]; IF LHIG=0 THEN LHIG←PIC[PCLN];
LWID←ABS(REALSCAN(INFL,FOO))*PIC[LNBY]; IF LWID=0 THEN LWID←PIC[LNBY];
UOUTSTR("NUMBER OF BITS:"); LBIT←(CVD(UINCHWL) MIN 36);
IF LBIT≤0 THEN LBIT←PIC[BYBI];
IF LBIT≠PIC[BYBI]∨LWID≠PIC[LNBY]∨LHIG≠PIC[PCLN] THEN
BEGIN
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBIT);
BACKLOG←"Z ";
END;
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("TMP.TMP[TMP,HPM]")];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(LHIG,LWID,LBIT,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
SHRINK(T[0],PIC[0]);
BACKLOG←"";
INITED←FALSE;
END;
END;
["0"] comment special hack for PPH;
BEGIN
OWN INTEGER LHIG,LWID,LBIT;
OWN INTEGER FACTOR;
INTEGER FOO;
STRING INFL;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
UOUTSTR("Factor to reduce by (small integer):");
FACTOR ← (CVD(UINCHWL) MAX 1);
LHIG←PIC[PCLN] DIV FACTOR;
LWID←PIC[LNBY] DIV FACTOR;
UOUTSTR("Number of bits:"); LBIT←(CVD(UINCHWL) MIN 36);
IF LBIT≤0 THEN LBIT←PIC[BYBI];
IF LBIT≠PIC[BYBI]∨LWID≠PIC[LNBY]∨LHIG≠PIC[PCLN] THEN
BEGIN
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBIT);
BACKLOG←"0 ";
END;
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("TMP.TMP[TMP,HPM]")];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(LHIG,LWID,LBIT,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
SQTILE(T[0],0,0,LHIG,LWID,FACTOR,FACTOR,PIC[0],0,0);
BACKLOG←"";
INITED←FALSE;
END;
END;
["~"] comment dequantize a picture;
BEGIN
OWN INTEGER LHIG,LWID,LBIT;
INTEGER FOO;
STRING INFL;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
LHIG←2*PIC[PCLN];
LWID←2*PIC[LNBY];
LBIT←PIC[BYBI];
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBIT);
BACKLOG←"~ ";
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("TMP.TMP[TMP,HPM]")];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(LHIG,LWID,LBIT,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
SHRINK(T[0],PIC[0]);
LOWPAS(PIC[0]);
BACKLOG←"";
INITED←FALSE;
END;
END;
["ε"] comment make DD buffer into a picture;
BEGIN
OWN INTEGER LHIG,LWID,LBIT;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
LHIG←481; LWID←512; LBIT←1;
PWANT←PIXDIM(HIG,WID,BIT);
BACKLOG←"ε ";
END
ELSE
BEGIN
INTEGER I;
MAKPIX(LHIG,LWID,LBIT,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
FOR I ← 0 STEP 1 UNTIL 480 DO
DDPAK(I,MEMORY[PIC[LINTAB+I]],0,511);
BACKLOG←"";
INITED←FALSE;
END;
END;
["$"] comment general geometric transformation;
BEGIN
OWN INTEGER HIG,WID,BIT;
INTEGER FOO;
STRING INFL;
own string tr1,tr2,tr3;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
integer com;
UOUTSTR("Transform (? for help):"); com←UINCHRW;
WHILE com="?" DO
BEGIN
Uoutstr("
R Rotate
M Mirror image
E Enter transform matrix
Transform:");
com←UINCHRW;
END;
COM←COM LAND '137;
if com="R" then
begin
REAL RT,SRT,CRT;
UOUTSTR("What fraction of a full turn:");
RT←REALSCAN(INFL←UINCHWL,FOO);
SRT←SIN(2*3.14159265*RT); CRT←COS(2*3.14159265*RT);
SETFORMAT(0,4);
TR1←CVF(CRT)&" "&CVF(SRT)&" "&CVF(.5*(1-SRT-CRT));
TR2←CVF(-SRT)&" "&CVF(CRT)&" "&CVF(.5*(1+SRT-CRT));
TR3←"0 0 1";
HIG←PIC[PCLN]*ABS(CRT)+PIC[LNBY]*ABS(SRT);
WID←PIC[LNBY]*ABS(CRT)+PIC[PCLN]*ABS(SRT);
RT←SQRT(PIC[PCLN]*PIC[LNBY]/(HIG*WID));
HIG←HIG*RT+.5;
WID←WID*RT+.5;
BIT←PIC[BYBI];
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
end
else if com="M" then
begin
TR1←"1 0 0";
TR2←"0 -1 1";
TR3←"0 0 1";
HIG←PIC[PCLN];
WID←PIC[LNBY];
BIT←PIC[BYBI];
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
end
else if com="E" then
begin
Uoutstr("Enter transform matrix."&'15&'12);
Uoutstr("tr[1,1:3] ← ");loded(tr1&'12);tr1←UINCHWL;
Uoutstr("tr[2,1:3] ← ");loded(tr2&'12);tr2←UINCHWL;
Uoutstr("tr[3,1:3] ← ");loded(tr3&'12);tr3←UINCHWL;
Uoutstr("height width BIT ← ");
loded(cvs(pic[pcln])&" "&cvs(pic[lnby])
&" "&cvs( pic[bybi] ) & '12); infl ← UINCHWL;
hig←intscan(infl,foo);
wid←intscan(infl,foo);
BIT←intscan(infl,foo);
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
end;
PWANT←PIXDIM(HIG,WID,BIT);
BACKLOG←"$ ";
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("DSK:TMP.TMP[TMP,HPM]")];
real array tr[1:3,1:3];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(HIG,WID,BIT,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
infl←tr1;tr[1,1]←realscan(infl,foo);tr[1,2]←realscan(infl,foo);tr[1,3]←realscan(infl,foo);
infl←tr2;tr[2,1]←realscan(infl,foo);tr[2,2]←realscan(infl,foo);tr[2,3]←realscan(infl,foo);
infl←tr3;tr[3,1]←realscan(infl,foo);tr[3,2]←realscan(infl,foo);tr[3,3]←realscan(infl,foo);
pixtrn(t[0],tr,pic[0]);
BACKLOG←"";
INITED←FALSE;
END;
END;
["U"] comment remove blank border from a picture;
BEGIN
INTEGER ARRAY ROW[0:PIC[PCLN]-1],COL[0:PIC[LNBY]-1];
INTEGER FHX,FHY,I,K,FLX,FLY,WID,HIG;
ROWSUM(PIC[0],ROW[0]);
K←0; FOR I←0 STEP 1 UNTIL PIC[PCLN]-1 DO K←K+ROW[I];
K←K/PIC[PCLN]; FLY←0; WHILE ROW[FLY]<K/2 DO FLY←FLY+1;
FHY←PIC[PCLN]-1; WHILE ROW[FHY]<K/2 DO FHY←FHY-1;
IF ROW[FLY]<K/1.5 THEN FLY←FLY+1;
IF ROW[FLY]<K/1.5 THEN FLY←FLY+1;
COLSUM(PIC[0],COL[0]);
K←0; FOR I←0 STEP 1 UNTIL PIC[LNBY]-1 DO K←K+COL[I];
K←K/PIC[LNBY]; FLX←0; WHILE COL[FLX]<K/2 DO FLX←FLX+1;
FHX←PIC[LNBY]-1; WHILE COL[FHX]<K/2 DO FHX←FHX-1;
WID←FHX-FLX+1; HIG←FHY-FLY+1;
IF BIT≠PIC[BYBI]∨WID≠PIC[LNBY]∨HIG≠PIC[PCLN] THEN
BEGIN
INTEGER ARRAY T[0:PHAVE];
COPPIC(PIC[0],T[0]);
MAKPIX(HIG,WID,BIT,PIC[0]);
TILE(T[0],FLY,FLX,PIC[PCLN],PIC[LNBY],PIC[0],0,0);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
PHAVE←PWANT←PIXDIM(HIG,WID,BIT);
INITED←FALSE;
END;
END;
["N"] comment apply noise remover;
BEGIN
CLEAN(PIC[0]);
END;
["V"] comment apply interest operator;
BEGIN
INTEGER WINDOW;
UOUTSTR(" WINDOW SIZE:"); WINDOW←CVD(UINCHWL);
IF WINDOW≥1 THEN
BEGIN
INTEREST(PIC[0],WINDOW,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
PWANT←PHAVE←PIXDIM(PIC[PCLN],PIC[LNBY],PIC[BYBI]);
INITED←FALSE;
END
ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["M"] comment pixel modification;
BEGIN
INTEGER ARRAY PERM[-1:PIC[BMAX]+1];
INTEGER FOO,I,J; STRING INP;
INTEGER NUMP;
INTEGER XXEOF,XXCOUNT,XXBRCHAR,XXFLAG;
XXEOF←XXFLAG←TRUE;
OPEN(10,"DSK",'10,19,0,XXCOUNT,XXBRCHAR,XXEOF);
IF ¬XXEOF THEN
BEGIN
LOOKUP(10,"PERM.TMP[TMP,HPM]",XXFLAG);
IF ¬XXEOF∧¬XXFLAG THEN ARRYIN(10,PERM[-1],PIC[BMAX]+2);
END;
RELEASE(10);
IF PERM[-1]≠PIC[BYBI] THEN
BEGIN
FOR I←0 STEP 1 UNTIL PIC[BMAX] DO PERM[I]←I;
PERM[-1]←PIC[BYBI];
END;
BEGIN
INTEGER ARRAY OLD,NEW[0:100];
UOUTSTR(CVS(PIC[BMAX])&" is maximum grey level"&
" enter piecewise linear link points"&'15&'12&
" old value , new value end with a blank line"&'15&'12);
NUMP←0;
WHILE LENGTH(INP←UINCHWL)>0 DO
BEGIN
NUMP←NUMP+1;
OLD[NUMP]←REALSCAN(INP,FOO);
NEW[NUMP]←REALSCAN(INP,FOO);
IF OLD[NUMP]<0∨OLD[NUMP]>PIC[BMAX] THEN
BEGIN PRINT("rejected",'15&'12); NUMP←NUMP-1; END;
END;
FOR I←1 STEP 1 UNTIL NUMP-1 DO
FOR J←I+1 STEP 1 UNTIL NUMP DO
IF OLD[I]>OLD[J] THEN BEGIN OLD[I]↔OLD[J]; NEW[I]↔NEW[J]; END;
IF NUMP>0 THEN
BEGIN OLD[NUMP+1]←OLD[NUMP]; NEW[NUMP+1]←NEW[NUMP]; END;
FOR I←1 STEP 1 UNTIL NUMP DO
BEGIN
FOR J←OLD[I] STEP 1 UNTIL OLD[I+1] DO
PERM[J]←(NEW[I+1]*(J-OLD[I])+NEW[I]*(OLD[I+1]-J+1))
%(OLD[I+1]+1-OLD[I]);
END;
END;
PERBIT(PIC[0],PERM[0]);
OPEN(10,"DSK",'10,0,19,XXCOUNT,XXBRCHAR,XXEOF);
IF ¬XXEOF THEN ENTER(10,"PERM.TMP[TMP,HPM]",XXFLAG);
IF ¬XXEOF∧¬XXFLAG THEN ARRYOUT(10,PERM[-1],PIC[BMAX]+2);
RELEASE(10);
END;
["G"] comment histogram pixel values;
BEGIN
INTEGER ARRAY HIST[0:PIC[BMAX]];
INTEGER CHN;
HISTOG(PIC[0],HIST[0]);
CHN ← GDDCHN(-1);
DRAWHIST(HIST,PIC[BMAX],CHN);
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
END;
["J"] comment histogram integrated pixel values;
BEGIN
INTEGER ARRAY HIST[0:PIC[BMAX]];
INTEGER I,FOO,CHN;
CHN ← GDDCHN(-1);
HISTOG(PIC[0],HIST[0]);
FOO ← PIC[BMAX];
FOR I←1 STEP 1 UNTIL FOO DO
HIST[I] ← HIST[I] + HIST[I-1];
DRAWHIST(HIST,FOO,CHN);
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
END;
["E"] comment apply histogram normalizer;
BEGIN
ENHANCE(PIC[0]);
END;
["Y"] comment apply vert sync loss correction;
BEGIN
SYNCHRONIZE(PIC[0]);
END;
["∩"] comment for hackery;
BEGIN
STRING S; INTEGER I,SCI,SCS,LIN;
INTEGER ARRAY MP[0:'37];
UOUTSTR("LINE #"); S←UINCHWL;
FOR I←0 STEP 1 UNTIL '37 DO MP[I]←I;
IF LENGTH(S)=0 THEN LIN←-1 ELSE LIN←CVO(S);
LINSCN('40,MP[0],90,LIN);
SCI←1; SCS←0;
WHILE (I←CALL(0,"SNEAKW"))≠'15 DO
BEGIN
CLRBUF;
CASE I OF
BEGIN
["+"]
IF SCI=0 THEN
BEGIN SCS←0; SCNINC(SCI←1); LINSCN('40,MP[0],90,LIN); END
ELSE IF SCI=-1 THEN SCNINC(SCI←1);
["-"]
IF SCI=0 THEN
BEGIN SCS←0; SCNINC(SCI←-1); LINSCN('40,MP[0],90,LIN); END
ELSE IF SCI=1 THEN SCNINC(SCI←-1);
[" "]["*"]
IF SCI=0 THEN
BEGIN SCNINC(SCI←SCS); SCS←0; LINSCN('40,MP[0],90,LIN); END
ELSE IF SCI≠0 THEN BEGIN SCS←SCI; SCNINC(SCI←0); SCNFRZ; END
END;
END;
SCNOFF;
INCHRW;
END;
["∞"] comment extend mode;
BEGIN
INTEGER CMD;
UOUTSTR("CMD:"); CMD←UCONV(UINCHRW);
CASE CMD OF
BEGIN
["?"] comment extend mode help;
OUTDPY(" Extended Commands
∞O Write out picture in a data compressed file (plain I command can read it)
∞> Write out picture in CMU format
∞⊂ Read in a packed byte picture file (scanlines begin inside words)
∞H Make a giant halftone file suitable for sending to the Varian
∞P Output a picture in text form to a file
∞S Make order of significance of synthesizer channels monotonic
∞E Enhance edges
∞→ Make histogram of horizontal spatial variance
∞↑ Make histogram of vertical spatial variance
∞; Initialize Grinnell but don't erase any channels
∞! Set Grinnell channel map for monochrome
∞← Set Grinnell channel map to next six channels
∞D Start a demo Grinnell file (for GRNDEM) ∞F finish the demo file
∞N Set multiple frame count for Grinnel picture taking
∞G Output picture on Grinnell
∞R Input picture from Grinnell
∞U Input picture from Grinnell, in unpacked mode
∞I Take and Input picture from Grinnell, GE camera mode
∞V Take and Input picture from Grinnell, Vidicon mode
∞Z Zoom and pan Grinnell channel(UIOJKNM, uiojknm, pan| +-* zoom| P pan_mode toggle|
<shift> makes large| <meta> makes continuous|. done| L leave at zoom/pan)
");
["E"] comment enhance edges;
BEGIN
INTEGER ARRAY T[0:PHAVE];
INTEGER I,J, HIG,WID,BIT;
HIG←PIC[PCLN];
WID←PIC[LNBY];
BIT←PIC[BYBI];
MAKPIX(HIG,WID,BIT,T[0]);
FOR I←0 STEP 1 UNTIL HIG-2 DO
BEGIN
FOR J←0 STEP 1 UNTIL WID-2 DO
BEGIN
PUTEL(T[0],I,J,
ABS(PIXEL(PIC[0],I,J)-PIXEL(PIC[0],I+1,J+1))+
ABS(PIXEL(PIC[0],I+1,J)-PIXEL(PIC[0],I,J+1)));
END;
END;
COPPIC(T[0],PIC[0]);
END;
["O"] comment output a data compressed file;
BEGIN
OWN STRING FN;
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)≠0 THEN
BEGIN
PUTPFL(PIC[0],FN,2);
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END
ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
[">"] comment output a CMU picture file;
BEGIN
OWN STRING FN;
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)≠0 THEN
BEGIN
INTEGER CH,EOF,COUNT,BRCHAR,FLAG;
INTEGER ARRAY BUF[0:127];
CH←GETCHAN;
PRSFIL(FN);
EOF←TRUE;
OPEN(CH,DEVPRS,'10,0,19,COUNT,BRCHAR,EOF);
IF ¬EOF THEN ENTER(CH,FILPRS,FLAG);
IF FLAG ∨ EOF THEN
BEGIN
RELEASE(CH);
OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END
ELSE
BEGIN
BUF[0]←128;
BUF[1]←PIC[BYBI];
BUF[2]←PIC[LNBY];
BUF[3]←PIC[LNWD];
BUF[4]←PIC[PCWD];
ARRYOUT(CH,BUF[0],'200);
ARRYOUT(CH,PIC[13+PIC[PCLN]+PIC[LNBYA]],PIC[PCWD]);
CLOSE(CH); RELEASE(CH);
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
END
END;
["⊂"] comment input packed byte file (scanline not on word boundary);
BEGIN
OWN STRING FN; STRING S; OWN INTEGER FOO,H,W,B;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("");
PRSFIL(FN);
UOUTSTR("FILE:"); FN←UINCHWL;
UOUTSTR("LINES, BYTES/LINE, BITS/BYTE:");
S←UINCHWL;
H←INTSCAN(S,FOO);
W←INTSCAN(S,FOO);
B←INTSCAN(S,FOO);
PWANT←PIXDIM(H,W,B);
BACKLOG←"∞⊂"&FN;
END
ELSE
BEGIN
INTEGER XXEOF,XXCOUNT,XXBRCHAR,XXFLAG,CH;
PRSFIL(FN);
MAKPIX(H,W,B,PIC[0]);
CH←GETCHAN;
XXEOF←TRUE;
OPEN(CH,DEVPRS,'10,19,0,XXCOUNT,XXBRCHAR,XXEOF);
IF ¬XXEOF THEN LOOKUP(CH,FILPRS,XXFLAG);
IF XXFLAG ∨ XXEOF THEN
BEGIN
RELEASE(CH);
PRINT("aborted",'15&'12);
END
ELSE
BEGIN
INTEGER NWDS;
INTEGER ARRAY TMP[0:NWDS←(H*W)%(36%B)];
ARRYIN(CH,TMP[0],NWDS+1);
RELEASE(CH);
UNPACK(TMP[0],PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END;
BACKLOG←"";
INITED←FALSE;
FN←DEVPRS&":"&FILPRS;
END;
END;
["S"] comment rearrange order of synthesizer channels;
BEGIN
INTEGER I;
FOR I←0 STEP 1 UNTIL 7 DO
MEMORY[LOCATION(ORDTAB)+I]←'37-I;
MAPGRY(MAPTF,8,TRUE);
END;
["M"] comment swap bytes in 12 bit pictures;
IF PIC[BYBI]=12 THEN
BEGIN
INTEGER I,J,SH; INTEGER ARRAY TAB[0:PIC[BMAX]];
SH←0;
FOR I←0 STEP 1 UNTIL PIC[PCLN]-1 DO
FOR J←0 STEP 1 UNTIL PIC[LNBY]-1 DO
SH←SH LOR PIXEL(PIC[0],I,J);
PRINT("Mask ",CVOS(SH),'15&'12);
SH←PIC[BYBI] ASH -1;
FOR I←0 STEP 1 UNTIL PIC[BMAX] DO
TAB[I]←(I LSH (SH-PIC[BYBI])) LOR (I LSH SH);
PERBIT(PIC[0],TAB[0]);
END;
["H"] comment make a giant halftone;
BEGIN "BIGHAF"
OWN STRING FN;
INTEGER ARRAY PO[0:10];
INTEGER I,J,K,L,M,PL,LN,OCH,DADDR; STRING S;
INTEGER PYLO,PXLO,PYHI,PXHI;
UOUTSTR("Output halftone dimensions in inches (height, width):");
S←UINCHWL; I←REALSCAN(S,K)*200; J←REALSCAN(S,K)*200;
MAKDIM(I,J+36,1,PO[0]);
PRSFIL(""); PRSFIL(FN);
DO BEGIN
UOUTSTR("Output file name:");
OCH←CREPFL(PO[0],UINCHWL,1);
END UNTIL OCH≥0;
FN←DEVPRS&":"&FILPRS;
PRINT("writing ",FN←DEVPRS&":"&FILPRS,'15&'12);
PYLO←0; PYHI←PO[PCLN]-1; PXLO←36; PXHI←PO[LNBY]-1;
BEGIN
DEFINE GRIDSIZ=4;
REAL BM;
LABEL BPTDL,ERRSZ,ERRSP,ERRSM,ERRSL,BPTSL,GRT,ERAJ,TRASH;
INTEGER ARRAY SCNLIN[0:PIC[LNWD]-1],BPTS,BPTD[0:PXHI-PXLO+1];
INTEGER ARRAY OUTLIN[0:PO[LNWD]-1];
REAL ARRAY ERRS[-1:PXHI-PXLO+2],THRES[0:GRIDSIZ-1,0:PXHI-PXLO+1];
FOR I←0 STEP 1 UNTIL GRIDSIZ%2-1 DO
FOR J←0 STEP 1 UNTIL PXHI-PXLO+1 DO
BEGIN INTEGER JJ;
JJ←J MOD GRIDSIZ; IF JJ≥GRIDSIZ%2 THEN JJ←GRIDSIZ-1-JJ;
THRES[GRIDSIZ-I-1,J]←THRES[I,J]←
((JJ-GRIDSIZ/4+.5)*(I-GRIDSIZ/4+.5)/(GRIDSIZ/4-.5)↑2)*.05+.5;
END;
FOR J←PXLO STEP 1 UNTIL PXHI DO
BEGIN
L←J-PXLO;
K←(PIC[LNBY]-1)*L/(PXHI-PXLO);
BPTS[L]←POINT(PIC[BYBI],SCNLIN[K%PIC[WDBY]],((K MOD PIC[WDBY])+1)*PIC[BYBI]-1);
BPTD[L]←POINT(1,OUTLIN[J%36],J MOD 36);
END;
BM←1/PIC[BMAX];
I←LOCATION(BPTD[0]); START_CODE MOVE 0,I; HRRM 0,BPTDL; END;
I←LOCATION(BPTS[0]); START_CODE MOVE 0,I; HRRM 0,BPTSL; END;
I←LOCATION(ERRS[0]); START_CODE MOVE 0,I; HRRM 0,ERRSL; HRRM 0,ERRSZ;
ADDI 0,1; HRRM 0,ERRSP; SUBI 0,2; HRRM 0,ERRSM; END;
DADDR←13+PIC[PCLN]+PIC[LNBYA];
PL←-1;
FOR I←PYLO STEP 1 UNTIL PYHI DO
BEGIN "YLOOP" DEFINE T=1, ER=3, J=2; INTEGER JJ;
ARRCLR(OUTLIN);
JJ←LOCATION(THRES[I MOD GRIDSIZ,0]);
START_CODE MOVE 0,JJ; HRRM 0,TRASH; END;
LN←(PIC[PCLN]-1)*(I-PYLO)/(PYHI-PYLO);
FOR PL←PL STEP 1 UNTIL LN DO
BEGIN
ARRBLT(SCNLIN[0],PIC[DADDR],PIC[LNWD]);
DADDR←DADDR+PIC[LNWD];
END;
JJ←(-ABS(PXHI-PXLO)-1) LSH 18;
START_CODE "XLOOP"
MOVEI T,1; MOVE J,JJ;
BPTSL: LDB ER,(J); FLTR ER,ER; FMPR ER,BM;
ERRSL: FADR ER,(J);
TRASH: CAML ER,(J); JRST GRT;
BPTDL: DPB T,(J); JRST ERAJ;
GRT: FSBRI ER,'201400; comment 1.0;
ERAJ: FDVRI ER,'202600; comment 3.0;
ERRSM: FADRM ER,(J);
ERRSZ: MOVEM ER,(J);
ERRSP: FADRM ER,(J);
AOBJN J,BPTSL;
END "XLOOP";
PFLOUT(OCH,OUTLIN[0],PO[LNWD]);
END "YLOOP";
PFLCLS(OCH);
END;
END "BIGHAF";
["→"] comment make histogram of horizontal spatial variance;
BEGIN "HSPATIAL"
INTEGER ARRAY HIST[0:PIC[BMAX]];
INTEGER MAXDIFF,I,J,OLD,NEW,DIFF,CHN;
REAL SUMSQ;
SUMSQ ← 0.0;
MAXDIFF ← 0;
FOR I ← 0 STEP 1 UNTIL PIC[BMAX] DO HIST[I] ← 0;
FOR I ← 0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
OLD ← PIXEL(PIC[0],I,0);
FOR J ← 1 STEP 1 UNTIL PIC[LNBY]-1 DO
BEGIN
NEW ← PIXEL(PIC[0],I,J);
DIFF ← ABS(NEW-OLD);
MAXDIFF ← MAXDIFF MAX DIFF;
HIST[DIFF] ← HIST[DIFF] + 1;
SUMSQ ← SUMSQ + DIFF↑2;
OLD ← NEW
END
END;
CHN ← GDDCHN(-1);
DRAWHIST(HIST,MAXDIFF,CHN);
OUTSTR("RMS Value is "&CVG(SQRT((SUMSQ/PIC[PCLN])/PIC[LNBY])));
OUTSTR('15&'12);
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
END "HSPATIAL";
["↑"] comment make histogram of vertical spatial variance;
BEGIN "VSPATIAL"
INTEGER ARRAY HIST[0:PIC[BMAX]];
INTEGER MAXDIFF,I,J,OLD,NEW,DIFF,CHN;
REAL SUMSQ;
SUMSQ ← 0.0;
MAXDIFF ← 0;
FOR I ← 0 STEP 1 UNTIL PIC[BMAX] DO HIST[I] ← 0;
FOR J ← 0 STEP 1 UNTIL PIC[LNBY]-1 DO
BEGIN
OLD ← PIXEL(PIC[0],0,J);
FOR I ← 1 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
NEW ← PIXEL(PIC[0],I,J);
DIFF ← ABS(NEW-OLD);
MAXDIFF ← MAXDIFF MAX DIFF;
HIST[DIFF] ← HIST[DIFF] + 1;
SUMSQ ← SUMSQ + DIFF↑2;
OLD ← NEW
END
END;
CHN ← GDDCHN(-1);
DRAWHIST(HIST,MAXDIFF,CHN);
OUTSTR("RMS Value is "&CVG(SQRT((SUMSQ/PIC[PCLN])/PIC[LNBY])));
OUTSTR('15&'12);
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
END "VSPATIAL";
[";"] comment set channel defaults through Grinnell ports;
BEGIN
comment card 0: A=stereo left B=stereo right C=video '43;
comment card 1: A=video '44 B=video '45 C=video '46;
BACKLOG←BACKLOG&"∞←0↔1↔0↔1↔2↔3↔";
END;
["!"] comment initialize the Grinnell for Ted's color kludge;
BEGIN
comment card 0:;
comment card 1:;
BACKLOG←BACKLOG&"∞←0↔0↔0↔0↔0↔0↔";
END;
["←"] comment set channel outputs as required;
BEGIN
REQUIRE "GRNDEF.[HDR,HE]" SOURCE_FILE;
INTEGER ARRAY LOOKUP_VALUES[0:255];
INTEGER I,a,b,c,d,e,f;
IF NOT GRNDEMO THEN GRNINI;
UOUTSTR("6 Channel numbers"&'15&'12);
UOUTSTR("Card 0, port a:");A←CVD(UINCHWL);
UOUTSTR(" port b:");B←CVD(UINCHWL);
UOUTSTR(" port c:");C←CVD(UINCHWL);
SWITCHCHAN(0,A,B,C);
UOUTSTR("Card 1, port d:");D←CVD(UINCHWL);
UOUTSTR(" port e:");E←CVD(UINCHWL);
UOUTSTR(" port f:");F←CVD(UINCHWL);
SWITCHCHAN(1,D,E,F);
comment turn off overlays on cards 0 and 1;
IFVCOUTPUT(0,0,0,0,0);
IFVCOUTPUT(1,0,0,0,0);
ZOOM_PAN(0,0,255,255,BLANKING); comment unzoom all channels;
ZOOM_PAN(1,0,255,255,BLANKING);
ZOOM_PAN(2,0,255,255,BLANKING);
ZOOM_PAN(3,0,255,255,BLANKING);
GSHOW_CURSOR(0,0); comment turn off all cursors;
comment set up all six intensity tables as 8-bit outputs;
MAPGRN(0,0,8); MAPGRN(0,1,8); MAPGRN(0,2,8);
MAPGRN(1,0,8); MAPGRN(1,1,8);
comment Here's yet another little crock!;
MAPGRN(1,2,IFC IPCBUSTED THENC 7 ELSEC 8 ENDC);
FOR I←0 STEP 1 UNTIL 255 DO LOOKUP_VALUES[I]← I IFC IPCBUSTED THENC lsh -1 ENDC;
IPCMAP('17,LOOKUP_VALUES,256,0); comment load lookup tables for 4 main mems;
comment make image processor pass channel 3 straight through;
IPCSWITCH(3,3,3,3,0); comment pass channel 3 straight through;
IPCCTRLMODE('00); comment chose lpr6;
IPCCONTROL(6,'140); comment (0 and 1) and (2 and 3);
BUFOUT;
IF NOT GRNDEMO THEN GRNFIN;
END;
["D"] comment start a Grinnell demonstration file;
BEGIN "GRINNELL DEMO"
IF GRNDEMO THEN
OUTSTR("Sorry, you have to finish the current one first."&'15&'12)
ELSE
BEGIN
GRNDEMO ← TRUE;
UOUTSTR("Demo filename:");
PRSFIL("");
PRSFIL(UINCHWL);
GRNINI;
DEMOMODE(DEVPRS,FILPRS)
END
END "GRINNELL DEMO";
["F"] comment finish a Grinnell demonstration file;
BEGIN "FINISH GRINNELL DEMO"
IF GRNDEMO THEN
BEGIN
GRNDEMO ← FALSE;
GRNFIN
END
ELSE
OUTSTR("Sorry, you have to start one first."&'15&'12)
END "FINISH GRINNELL DEMO";
["G"] comment draw picture on Grinnell display;
BEGIN "GRNDIS"
GRNLEFT ← ((512-PIC[LNBY]) DIV 2) MAX 0;
GRNTOP ← ((511+PIC[PCLN]) DIV 2) MAX 0; comment 511 so that 512 high works;
GRNDISP←TRUE;
IF NOT GRNDEMO THEN GRNINI;
ERASEG(GRNCHAN);
Comment Shift left to make picture visible;
VIDGRN(GRNLEFT,GRNTOP,GRNCHAN,PIC,8-PIC[BYBI]);
IF NOT GRNDEMO THEN GRNFIN;
END "GRNDIS";
["R"] comment read back picture from Grinnell display;
BEGIN "INGRN"
OWN INTEGER LHIG,LWID,LBIT;
INTEGER FOO;
STRING INFL;
IF GRNDEMO THEN
OUTSTR("Sorry, you can't do that during a demo."&'15&'12)
ELSE
BEGIN
IF LENGTH(BACKLOG)=0 THEN
BEGIN
LHIG ← 512; LWID ← 512; LBIT ← 8;
BACKLOG←"∞R ";
IF LBIT≠PIC[BYBI]∨LWID≠PIC[LNBY]∨LHIG≠PIC[PCLN] THEN
BEGIN
comment PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBIT);
END;
END
ELSE
BEGIN
comment INTEGER ARRAY T[0:PFLDIM("TMP.TMP[TMP,HPM]")];
comment GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
comment MAKPIX(LHIG,LWID,LBIT,PIC[0]); comment inpic makes its own;
INPIC(GRNCHAN,PIC);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
comment SHRINK(T[0],PIC[0]);
BACKLOG←"";
INITED←FALSE;
END;
END
END "INGRN";
["U"] comment read back unpacked picture from Grinnell display;
BEGIN "UINGRN"
OWN INTEGER LHIG,LWID,LBIT;
INTEGER FOO;
STRING INFL;
IF GRNDEMO THEN
OUTSTR("Sorry, you can't do that during a demo."&'15&'12)
ELSE
BEGIN
IF LENGTH(BACKLOG)=0 THEN
BEGIN
LHIG ← 512; LWID ← 512; LBIT ← 8;
BACKLOG←"∞U ";
IF LBIT≠PIC[BYBI]∨LWID≠PIC[LNBY]∨LHIG≠PIC[PCLN] THEN
BEGIN
comment PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBIT);
END;
END
ELSE
BEGIN
comment INTEGER ARRAY T[0:PFLDIM("TMP.TMP[TMP,HPM]")];
comment GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
comment MAKPIX(LHIG,LWID,LBIT,PIC[0]); comment inpic makes its own;
UINPIC(GRNCHAN,PIC);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
comment SHRINK(T[0],PIC[0]);
comment BACKLOG←"";
INITED←FALSE;
END;
END
END "UINGRN";
["I"] comment take a GE format picture through the Grinnell digitizer;
BEGIN "GEIN"
IF GRNDEMO THEN
OUTSTR("Sorry, you can't do that during a demo."&'15&'12)
ELSE
BEGIN
GRNINI;
GETAKE(PIC,CAMERA,2,TRUE,NFRAMES); comment Camera, gechan 2, corrected lines;
GRNFIN;
END
END "GEIN";
["V"] comment take a Vidicon picture through the Grinnell digitizer;
BEGIN "VIDIN"
IF GRNDEMO THEN
OUTSTR("Sorry, you can't do that during a demo."&'15&'12)
ELSE
BEGIN
GRNINI;
GRPICTAKE(CAMERA,NFRAMES); comment Camera, and frame count;
IF 8≠PIC[BYBI]∨512≠PIC[LNBY]∨512≠PIC[PCLN] THEN
BEGIN
comment PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(512,512,8);
END;
BACKLOG←"SG2↔∞U↔SG"&CVS(GRNCHAN)&"↔"; comment what a kludge;
GRNFIN;
END
END "VIDIN";
["N"] comment set NFRAMES for multiple picture taking;
BEGIN "NFRAMES"
UOUTSTR("Number of frames:"); NFRAMES←CVD(UINCHWL);
END "NFRAMES";
["Z"] comment do zoom and pan;
Begin "zoompan"
INTEGER XVAL,YVAL;
BOOLEAN MCURSOR,CBLINK;
UOUTSTR("Mid pixel cursor?:");
MCURSOR←(IF UCONV(UINCHWL)= "Y" THEN TRUE ELSE FALSE);
UOUTSTR("Blinking cursor?:");
CBLINK←(IF UCONV(UINCHWL)= "Y" THEN TRUE ELSE FALSE);
IF NOT GRNDEMO THEN GRNINI;
IF GRNDISP THEN comment if PIX put up image, use its dimens;
ZOOMCURSOR(GRNCHAN,GRNLEFT,GRNTOP,PIC[PCLN],PIC[LNBY],
XVAL,YVAL,MCURSOR,CBLINK)
ELSE comment else act as though its 512*512;
ZOOMCURSOR(GRNCHAN,0,511,512,512,XVAL,YVAL,MCURSOR,CBLINK);
IF NOT GRNDEMO THEN GRNFIN;
PRINT ("Coordinate pair: (",XVAL,",",YVAL,")",'15&'12);
End "zoompan";
["P"] comment display text form of picture into file;
BEGIN
INTEGER I,J,K,L,M,CHN;
STRING FN;
REAL ASP;
INTEGER SX,SY;
PRSFIL("");
DO
BEGIN
UOUTSTR("Output file name:");
FN←UINCHWL;
IF LENGTH(FN)>0 THEN PRSFIL(FN);
M←1;
CHN←GETCHAN;
OPEN(CHN,DEVPRS,0,0,19,0,0,M);
ENTER(CHN,FILPRS,M);
IF M THEN UOUTSTR("File "&DEVPRS&":"&FILPRS&" cannot be created."&'15&'12);
END
UNTIL ¬M;
ASP←PIC[PCLN]/PIC[LNBY];
SX←TWID; SY←SX*ASP*TASPECT;
IF SY>TLEN THEN BEGIN SX←SX*TLEN/SY; SY←TLEN; END;
BEGIN
REAL PCMAX;
PCMAX←2↑PIC[BYBI]-1;
OUT(CHN,'15&'12);
FOR J←0 STEP 1 UNTIL SY-1 DO
BEGIN
FOR I←0 STEP 1 UNTIL SX-1 DO
BEGIN
PRELOAD_WITH " ","`",".","-","'","/",":","+","1","[","0",
"X","%","A","Q","M","*";
OWN INTEGER ARRAY GRT[0:16];
IF TBRITE THEN
OUT(CHN,GRT[16*
PIXEL(PIC[0],PIC[PCLN]*J%SY,PIC[LNBY]*I%SX)/PCMAX])
ELSE
OUT(CHN,GRT[16*
(1-PIXEL(PIC[0],PIC[PCLN]*J%SY,PIC[LNBY]*I%SX)/PCMAX)]);
END;
OUT(CHN,'15&'12);
END;
END;
CLOSE(CHN); RELEASE(CHN);
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
ELSE PRINT("huh?",'15&'12)
END;
END;
["Q"] comment exit;
BEGIN
if outddcalled then OUTDPY('40&'15&'12);
CALL(0,"EXIT");
END;
Comment This is the resting place for all defunct stuff. It should be put
here to reduce core size of PIX;
IFC FALSE THENC
""∞T"" Take multiple pictures from selected source and combine matching ones
["T"] comment send mail to digitizer job;
BEGIN
INTEGER DT;
FOR DT←0 STEP 1 UNTIL 10 DO
BEGIN "MAIL"
STRING S; BOOLEAN NEED_RETRY;
EXTERNAL INTEGER _SKIP_; STRING POU; INTEGER I;
PRELOAD_WITH 0; OWN INTEGER ARRAY ISPTY[1:2];
INTEGER ARRAY HD[1:2],MESSAGE[1:32];
NEED_RETRY←FALSE;
IF ¬ISPTY[1] THEN
BEGIN "create a pty for DIGITIZ job"
DO
BEGIN
ISPTY[1]←PTYGET;
IF _SKIP_=0 THEN
BEGIN PRINT(" ptyget failed "); CALL(5,"SLEEP"); END;
END
UNTIL _SKIP_≠0;
DO
BEGIN
ISPTY[2]←5; comment LOGIN function;
START_CODE PTYUUO '16,ACCESS(ISPTY[1]); comment PTJOBX; END;
IF ISPTY[2]=0 THEN
BEGIN PRINT(" login failed "); CALL(5,"SLEEP"); END;
END
UNTIL ISPTY[2]>0;
PTOSTR(ISPTY[1],"R DIGTIZ"&'15&'12);
POU←"";
DO POU←POU&PTCHRW(ISPTY[1]) UNTIL
EQU(POU[∞-4 TO ∞],"READY") ∨
EQU(POU[∞-4 TO ∞],"found");
IF EQU(POU[∞-4 TO ∞],"found") THEN BEGIN PRINT(POU,'15&'12);
PTOSTR(ISPTY[1],"K/F"&'15&'12); CALL(1,"SLEEP");
PTYREL(ISPTY[1]); ISPTY[1]←0; DONE "MAIL"; END;
END;
MESSAGE[1]←CALL(0,"PJOB");
MESSAGE[2]←HIG; MESSAGE[3]←WID; MESSAGE[4]←BIT;
MESSAGE[5]←CAMERA; MESSAGE[6]←YEE; MESSAGE[7]←XEE;
MESSAGE[8]←BCL; MESSAGE[9]←TCL; MESSAGE[10]←SUMS;
MEMORY[LOCATION(MESSAGE[11]),REAL]←REDUN; MESSAGE[12]←CVSIX("DSK");
MESSAGE[13]←CVSIX("TMP"); MESSAGE[14]←CVSIX("TMP");
MESSAGE[15]←CVSIX("TMP"); MESSAGE[16]←CVSIX("HPM");
MESSAGE[17]←DT;
HD[1]←ISPTY[2]; HD[2]←LOCATION(MESSAGE[1]);
DO BEGIN I←0;
START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; SETOM I; END;
IF I≠0 THEN CALL(0,"SLEEP");
END UNTIL I=0;
DO BEGIN
INTEGER STAT;
S←PTYALL(ISPTY[1]);
IF S[∞ TO ∞]≠"!" THEN
BEGIN
CALL(0,"SLEEP");
IF S[∞ TO ∞]="?" THEN PTOSTR(ISPTY[1],"ββ C 0"&'15&'12);
STAT←CALL(ISPTY[2],"JBTSTS");
IF (STAT LAND '400000000000) = 0 THEN
BEGIN PRINT("DIGTIZ died! Probably too many pictures requested.",'15&'12);
PTOSTR(ISPTY[1],"K/F"&'15&'12); CALL(1,"SLEEP");
PTYREL(ISPTY[1]); ISPTY[1]←0; DONE "MAIL"; END;
END;
END UNTIL S[∞ TO ∞]="!";
MESSAGE[1]←-1;
HD[1]←ISPTY[2]; HD[2]←LOCATION(MESSAGE[1]);
DO BEGIN I←0;
START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; SETOM I; END;
IF I≠0 THEN CALL(0,"SLEEP");
END UNTIL I=0;
WHILE TRUE DO
BEGIN "MAIL WAIT"
INTEGER STAT; I←0;
START_CODE MAIL 2,ACCESS(MESSAGE[1]); comment SRCV; SETOM I; END;
IF I=0 THEN DONE "MAIL WAIT"; CALL(0,"SLEEP");
STAT←CALL(ISPTY[2],"JBTSTS");
IF (STAT LAND '400000000000) = 0 THEN
BEGIN PRINT("DIGTIZ died! (probably free storage limit)");
PTOSTR(ISPTY[1],"K/F"&'15&'12); CALL(1,"SLEEP");
PTYREL(ISPTY[1]); ISPTY[1]←0;
NEED_RETRY←TRUE; DONE "MAIL WAIT"; END;
END "MAIL WAIT";
IF ¬NEED_RETRY THEN
BEGIN
PRINT("ok ");
BACKLOG←"∞,"; PWANT←PDEFAULT;
DONE "MAIL";
END
ELSE IF DT≠10 THEN PRINT(" retry",'15&'12)
ELSE PRINT(" give up",'15&'12);
END "MAIL";
END;
[","] comment read in TMP file for ∞T command;
BEGIN
INTEGER ARRAY MESSAGE[1:32];
START_CODE MAIL 1,ACCESS(MESSAGE[1]); comment WRCV; END;
GETPFL("DSK:TMP.TMP[TMP,HPM]",PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END;
""∞B"" Set redunancy for ∞T command
["B"] comment set redundancy of digitizer;
BEGIN
STRING S; INTEGER FOO; REAL T;
UOUTSTR("DIGITIZING REDUNDANCY (NOW "&CVF(REDUN)&"):");
T←REALSCAN(S←UINCHWL,FOO); IF T>0 THEN REDUN←T;
END;
""∞D"" Digitizer exercises. Exorcises the digitizer when it makes bars.
["D"] comment exercize the digitizer;
BEGIN
INTEGER NRT,NPX,I,CAMRA,CAM;
INTEGER ARRAY T[0:PIXDIM(PIC[PCLN],PIC[LNBY],4)];
CAMRA←CAMERA;
IF CAMRA>'40 THEN CAMRA←CAMRA LAND '67;
IF CAMRA='42∨CAMRA='41 THEN CAM←CAMRA LAND 3 ELSE
BEGIN INTEGER I,J;
I←'401400000000 LOR LOCATION(J);
J←IF CAMRA≥'40 THEN CAMRA LAND 7 ELSE 1 LSH (35-CAMRA);
START_CODE
MOVE 1,I;
CALLI 1,'400070; COMMENT VDSMAP;
JUMP 0,0;
END;
CAM←3;
END;
MAKPIX(PIC[PCLN],PIC[LNBY],4,T[0]);
UOUTSTR("HOW MANY TIMES:"); NPX←CVD(UINCHWL);
NRT←0; FOR I←1 STEP 1 UNTIL NPX DO
BEGIN
PRINT(".");
NRT←NRT LOR TVRAW(CAM,YEE,XEE,T[0],BCL,TCL,NRTRY);
END;
PRINT(" ",(IF NRT<0 THEN " aborted " ELSE
CVS(NRT)&" RETR"&(IF NRT≠1 THEN "IES" ELSE "Y")),'15&'12);
IF NRT≥0 THEN
BEGIN
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
TVGRY(T[0]);
SHRINK(T[0],PIC[0]);
END
END;
""X"", ""ε"", ""α"", ""π"", "">"", ""<"" copy the last DD display
X to XGP, ε to picture, α to font, π to PJ dpy, > to and < from MIT files
["π"] comment output dd buf to jarvis term.;
begin
if ¬pjup then outstr("failed") else show('41);
end;
""B"", ""←"" set video digitizer parameters.
B bits/sample, window, ← video source (default=44)
["B"] comment alter bits/pixel, size and # to average;
BEGIN
INTEGER T,FOO; STRING INST;
UOUTSTR(" PICTURE HEIGHT, WIDTH (NOW "&CVS(HIG)&", "&CVS(WID)&"):");
INST←UINCHWL;
IF LENGTH(INST)>2 THEN
BEGIN
HIG←INTSCAN(INST,FOO); WID←INTSCAN(INST,FOO);
END;
UOUTSTR(" PICTURE YEDGE, XEDGE (NOW "&CVS(YEE%2)&", "&CVS(XEE)&"):");
INST←UINCHWL;
IF LENGTH(INST)>2 THEN
BEGIN
YEE←2*INTSCAN(INST,FOO); XEE←INTSCAN(INST,FOO) MAX 1;
END;
UOUTSTR(" NO. OF PICTURES TO AVERAGE (NOW "&CVS(SUMS)&"):");
T←CVD(UINCHWL); IF T>0 THEN SUMS←T;
UOUTSTR(" BITS/PIXEL (NOW "&CVS(BIT)&"):");
T←CVD(UINCHWL); IF T>0 THEN BIT←T MIN 36;
UOUTSTR(" SUPPRESS PARTIAL RETRIES?");
NRTRY←(IF (UINCHWL LAND '137)="Y" THEN -200 ELSE 100);
PDEFAULT←PWANT←PIXDIM(HIG,WID,BIT);
END;
This stuff used to be in PIXHDR:
external INTEGER PROCEDURE CAMPIX(INTEGER CAMRA,YEDGE,XEDGE;
REFERENCE INTEGER PIC;
INTEGER SUMS(1),BCLIP(7),TCLIP(0),NTRY(20));
EXTERNAL INTEGER PROCEDURE CLPADJ(INTEGER CAMRA;
REFERENCE INTEGER BCLIP,TCLIP;
REAL LIMB(.01),LIMT(.01) );
EXTERNAL PROCEDURE TVBTMX(REFERENCE INTEGER PIC4,PICN,XFRM; INTEGER INHIBEQ(15));
EXTERNAL PROCEDURE TVBTMY(REFERENCE INTEGER PIC4,PICN,XFRM; INTEGER INHIBLE(15));
EXTERNAL PROCEDURE TVBTMZ(REFERENCE INTEGER PIC4,PICN,XFRM; INTEGER INHIBGE(15));
EXTERNAL INTEGER PROCEDURE TVSNAP(INTEGER CAM,YEDG,XEDG;
REFERENCE INTEGER PIC;
INTEGER BCLIP,TCLIP,NTRY);
EXTERNAL INTEGER PROCEDURE TVRAW(INTEGER CAM,YEDG,XEDG;
REFERENCE INTEGER PIC;
INTEGER BCLIP,TCLIP,NTRY);
EXTERNAL PROCEDURE TVGRY(REFERENCE INTEGER PIC);
""T"" take a picture from currently selected source
["T"] comment take a picture via a camera;
BEGIN
INTEGER NRT;
IF PHAVE=PDEFAULT THEN
BEGIN
IF ¬INITED THEN
BEGIN
MAKPIX(HIG,WID,BIT,PIC[0]);
INITED←TRUE;
END;
NRT←CAMPIX(CAMERA,YEE,XEE,PIC[0],SUMS,BCL,TCL,NRTRY);
PRINT(" ",(IF NRT<0 THEN " aborted " ELSE
CVS(NRT)&" RETR"&(IF NRT≠1 THEN "IES" ELSE "Y")),'15&'12);
IF NRT≥0 THEN
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END
ELSE
BEGIN
BACKLOG←"T";
PWANT←PDEFAULT;
END;
END;
["↑"] comment optimize clip levels;
BEGIN
STRING SIN; INTEGER FOO;
UOUTSTR("<CR> FOR AUTO OR TCLIP, BCLIP (0≤TCLIP≤BCLIP≤7):"); SIN←UINCHWL;
IF LENGTH(SIN)≠0 THEN
BEGIN
TCL←INTSCAN(SIN,FOO);
BCL←INTSCAN(SIN,FOO);
END
ELSE
BEGIN
INTEGER NRT;
NRT←CLPADJ(CAMERA,BCL,TCL);
IF NRT<0 THEN OUTSTR(" aborted "&'15&'12) ELSE
IF NRT>0 THEN OUTSTR(" "&CVS(NRT)&
" RETR"&(IF NRT≠1 THEN "IES" ELSE "Y")&'15&'12);
OUTSTR("TCLIP="&CVS(TCL)&" BCLIP="&CVS(BCL)&'15&'12);
END;
END;
This is the REALLY old version:
["↑"] comment optimize clip levels;
BEGIN
STRING SIN; INTEGER FOO,NRT; REAL TT,BT;
UOUTSTR("BCLIP, TCLIP thresholds:"); SIN←UINCHWL;
BT←REALSCAN(SIN,FOO);
TT←REALSCAN(SIN,FOO);
NRT←CLPADJ(CAMERA,BCL,TCL,BT,TT);
IF NRT<0 THEN OUTSTR(" aborted "&'15&'12) ELSE
IF NRT>0 THEN OUTSTR(" "&CVS(NRT)&
" RETR"&(IF NRT≠1 THEN "IES" ELSE "Y")&'15&'12);
OUTSTR("TCLIP="&CVS(TCL)&" BCLIP="&CVS(BCL)&'15&'12);
END;
""∞Y"" Unscramble scan lines, as in pictures taken with GE camera
["Y"] comment unscramble scan lines, as from GE camera;
BEGIN
INTEGER ARRAY LIN[0:PIC[LNWD]];
INTEGER I,I0,LW;
LW←PIC[LNWD];
UOUTSTR("Starting line (0 or 1):");
I0←CVD(UINCHWL) LAND 1;
FOR I←I0 STEP 2 UNTIL PIC[PCLN]-2 DO
BEGIN
ARRBLT(LIN[0],MEMORY[PIC[LINTAB+I]],LW);
ARRBLT(MEMORY[PIC[LINTAB+I]],MEMORY[PIC[LINTAB+I+1]],LW);
ARRBLT(MEMORY[PIC[LINTAB+I+1]],LIN[0],LW);
END;
END;
ENDC
ELSE PRINT("?",'15&'12)
END "COMMAND";
END "SAMEARRAY";
PHAVE←PWANT;
END "LOOP";
END "PIX";